Posts by tswood

tswood · Feb 1st 2017

Hello,

I am trying to sort a column in excel from A to Z. There are cells that contain the following:

- whole numbers only e.g. 24, 6 etc.
- whole numbers and text string e.g. 24 years etc.
- decimal numbers e.g. 7.23, 27.46 etc.
- decimal numbers and text string e.g. 7.23 years etc.

I am encountering problems whereby excel 'reads' a number like 7.23 as 723. As a result, it is not sorting properly by putting in the appropriate sequence (e.g. 7, 7.23, 7.5, 8 etc.)

As there is also text in the cells I am unable to simply switch the cell format to 'number'.

Is there a way to make sure excel recognizes the decimal numbers appropriately?

Any assistance would be greatly appreciated.

Thank you

tswood · Oct 3rd 2016

Re: Code does not 'run' when assigned to a button

Okay, thank-you. Let me try that again.

I created code that executes correctly when I select Run from the VBA screen. The code is within a Standard Code Module (see below).

Code

Option Compare Text




Sub Create_Security_List_v3()




Set wsSource = Worksheets("Registration")
Set wsTarget = Worksheets("Security List")
Set wsPart = Worksheets("Participant List")




Dim lastRow As Long




Application.ScreenUpdating = False




'Clear cells for the purpose of re-submitting security list




Range("A12:E111").ClearContents




wsSource.Activate




'Sort registration names alphabetically




Application.ScreenUpdating = False




Dim r As Range
Set r = wsSource.Cells(2, 6)




r.Select
wsSource.Sort.SortFields.Clear
wsSource.Sort.SortFields.Add Key:=r, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal




With wsSource.Sort
    .SetRange Range("A2", Range("A2").End(xlDown).End(xlToRight))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With




'Sequential numbering for Registration Sheet




wsSource.Range("A2") = 1
wsSource.Range("A2").Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=Cells(Rows.Count, "A").End(xlUp).Row - 1, Trend:=False




'Move judicial officers to Security List by checking 'Position'




For i = 1 To Cells(Rows.Count, "C").End(xlUp).Row
If InStr(1, wsSource.Cells(i, 3).Value, "Magistrate") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Judge") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Justice") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Coroner") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Registrar") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Member") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "President") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




End If




Next i




wsTarget.Activate




'Sequential numbering




    'r = row, c = column
    Application.Goto Reference:="R12C1"
    Selection.End(xlDown).Select
    
    Dim maxRowIndex As Integer
    '-4 to account for the header row. Remove or adjust at will
    maxRowIndex = ActiveCell.Row - 11
    
    'set up starting point of repetition structure
    Range("A12").Select
    Dim rowCounter As Integer
    rowCounter = 1
    
    'begin populating sequence
    For rowCounter = 1 To maxRowIndex
        'populate number in sequence
        ActiveCell = rowCounter
        'go to next row
        ActiveCell.Offset(1).Select
    Next




'Copy program title




Dim lRow As Integer




With wsPart
lRow = wsTarget.Range("A5").CurrentRegion.Rows.Count
.Range("A5:F9").Copy wsTarget.Range("A5")
End With




'Changing the height of the empty rows




Rows(8).RowHeight = 10.5




'Hide blank 'program title' rows




Dim rngBlnk As Range




On Error Resume Next
Set rngBlnk = Range("A5:A7").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0




If Not rngBlnk Is Nothing Then
rngBlnk.EntireRow.Hidden = True
End If




Application.ScreenUpdating = True




End Sub

Display More

I then assigned the code to Button (Form Control) which has caused the code to run incorrectly.

The first issue is to do with the part of the code that finds a match on wsSource and then copies the columns to wsTarget.

When I select Run in the VBA screen this occurs (which is correct)

[ATTACH=CONFIG]70346[/ATTACH]

When I select the Button the following occurs (which is incorrect):

[ATTACH=CONFIG]70347[/ATTACH]

The second issue is that when I select the Button I encounter the following error:

Run-time error '6': Overflow

When I select Debug I can see that the part of the code that is causing this error is as follows:

Code

maxRowIndex = ActiveCell.Row - 11

Any assistance would be greatly appreciated.

Thank-you

tswood · Sep 29th 2016

I have created code that works perfectly when I select 'run' from the vba screen, however when I assign this code to a button it fails to run in the same way and encounters errors.

The code I am using is as follows:

Code

Option Compare Text




Sub Create_Security_List_v3()




Set wsSource = Worksheets("Registration")
Set wsTarget = Worksheets("Presenter List")
Set wsPart = Worksheets("Participant List")




Dim lastRow As Long




Application.ScreenUpdating = False




Range("A12:E111").ClearContents




wsSource.Activate




Application.ScreenUpdating = False




Dim r As Range
Set r = wsSource.Cells(2, 6)




r.Select
wsSource.Sort.SortFields.Clear
wsSource.Sort.SortFields.Add Key:=r, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal




With wsSource.Sort
    .SetRange Range("A2", Range("A2").End(xlDown).End(xlToRight))
    .Header = xlNo
    .MatchCase = False
    .Orientation = xlTopToBottom
    .SortMethod = xlPinYin
    .Apply
End With




wsSource.Range("A2") = 1
wsSource.Range("A2").Select
Selection.DataSeries Rowcol:=xlColumns, Type:=xlLinear, Date:=xlDay, Step:=1, Stop:=Cells(Rows.Count, "A").End(xlUp).Row - 1, Trend:=False




For i = 1 To Cells(Rows.Count, "C").End(xlUp).Row
If InStr(1, wsSource.Cells(i, 3).Value, "Complete") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




ElseIf InStr(1, wsSource.Cells(i, 3).Value, "Tentative") > 0 Then
With wsTarget
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Cells(i, 1).Copy
.Cells(lastRow + 1, "A").PasteSpecial
Cells(i, 3).Copy
.Cells(lastRow + 1, "B").PasteSpecial
Cells(i, 8).Copy
.Cells(lastRow + 1, "C").PasteSpecial
Cells(i, 6).Copy
.Cells(lastRow + 1, "D").PasteSpecial
Cells(i, 2).Copy
.Cells(lastRow + 1, "E").PasteSpecial
End With




End If




Next i




wsTarget.Activate




    Application.Goto Reference:="R12C1"
    Selection.End(xlDown).Select
    
    Dim maxRowIndex As Integer
    '-4 to account for the header row. Remove or adjust at will
    maxRowIndex = ActiveCell.Row - 11
    
    Range("A12").Select
    Dim rowCounter As Integer
    rowCounter = 1
    
    For rowCounter = 1 To maxRowIndex
        'populate number in sequence
        ActiveCell = rowCounter
        'go to next row
        ActiveCell.Offset(1).Select
    Next




Dim lRow As Integer




With wsPart
lRow = wsTarget.Range("A5").CurrentRegion.Rows.Count
.Range("A5:F9").Copy wsTarget.Range("A5")
End With




Rows(8).RowHeight = 10.5




Dim rngBlnk As Range




On Error Resume Next
Set rngBlnk = Range("A5:A7").SpecialCells(xlCellTypeBlanks)
On Error GoTo 0




If Not rngBlnk Is Nothing Then
rngBlnk.EntireRow.Hidden = True
End If




Application.ScreenUpdating = True




End Sub

Display More

Is there a reason why this may be occurring?

Thanks

tswood · Sep 26th 2016

Re: Insert and delete rows within an IF statement

Hello,

Thank you all for your help and patience with this issue.

This is the code I am now using:

Code

Set wsSource = Worksheets("Video-Conferencing")
Set wsTarget = Worksheets("Withdrawals")




Dim lastRow As Long
For i = Cells(Rows.Count, "N").End(xlUp).Row To 1 Step -1
    If Cells(i, 14) = "no" Then
        With wsTarget
            lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
            Range(Cells(i, 2), Cells(i, 10)).Copy
            .Cells(lastRow + 1, "B").PasteSpecial xlPasteValues
            Cells(i, 16).Copy
            .Cells(lastRow + 1, "L").PasteSpecial xlPasteValues
        End With
    End If
Next i

Display More

It is very likely that I am just not understanding the advice you are giving. I thought I'd try explaining myself a little better in case I haven't been clear.

After the data from wsSource has been copied to wsTarget I am trying to find a way to do the following:

1. Delete the row as the data is no longer needed in wsSource
I believe that this code should do this - Range("N" & i).EntireRow.Delete Shift:=xlUp

2. There are 101 rows in wsSource (column A has a heading and then is numbered 1 to 100). So that there are always 101 rows I want to add a row at the bottom.
I believe this code should do this - Range("A100").EntireRow.Insert

How can I incorporate this into the code listed?

tswood · Sep 23rd 2016

Re: Insert and delete rows within an IF statement

The issue I am having is that this code works:

Code

Dim lastRow As Long
For i = 1 To Cells(Rows.Count, "N").End(xlUp).Row
    If Cells(i, 14) = "no" Then
        With wsTarget
            lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
            Range(Cells(i, 2), Cells(i, 10)).Copy
            .Cells(lastRow + 1, "B").PasteSpecial xlPasteValues
            Cells(i, 16).Copy
            .Cells(lastRow + 1, "L").PasteSpecial xlPasteValues
        End With
    End If
Next i

Display More

But this code does not:

Code

Dim lastRow As Long
For i = 1 To Cells(Rows.Count, "N").End(xlUp).Row
    If Cells(i, 14) = "no" Then
        With wsTarget
            lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
            Range(Cells(i, 2), Cells(i, 10)).Copy
            .Cells(lastRow + 1, "B").PasteSpecial xlPasteValues
            Cells(i, 16).Copy
            .Cells(lastRow + 1, "L").PasteSpecial xlPasteValues
        End With
      Range("N" & i).EntireRow.Delete Shift:=xlUp
            Range("A100").EntireRow.Insert


    End If
Next i

Display More

I can see where I am going wrong but not how to fix it.

tswood · Sep 22nd 2016

Re: Insert and delete rows within an IF statement

Hello,

Thank you for your response.

Here is the full code:

Code

Set wsSource = Worksheets("Video")
Set wsTarget = Worksheets("Withdrawals")




Dim lastRow As Long
For i = 1 To Cells(Rows.Count, "N").End(xlUp).Row
    If Cells(i, 14) = "no" Then
        With wsTarget
            lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
            Range(Cells(i, 2), Cells(i, 10)).Copy
            .Cells(lastRow + 1, "B").PasteSpecial xlPasteValues
            Cells(i, 16).Copy
            .Cells(lastRow + 1, "L").PasteSpecial xlPasteValues
        End With
         Range("N" & i).EntireRow.Delete Shift:=xlUp
        Range("A100").EntireRow.Insert
    End If
Next i

Display More

Yes the sheet I want the range to refer to is the active sheet. Where I have put a (.) before 'Cells' is referring to the non-active sheet.

tswood · Sep 22nd 2016

Hello,

In the code below, the lines to delete and insert a row are causing the code not to execute.

Does anyone have any suggestions on how I might go about rectifying this?

Code

Dim lastRow As Long
For i = 1 To Cells(Rows.Count, "N").End(xlUp).Row
    If Cells(i, 14) = "no" Then
        With wsTarget
            lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
             
            Range(Cells(i, 2), Cells(i, 10)).Copy
            .Cells(lastRow + 1, "B").PasteSpecial xlPasteValues
            Cells(i, 16).Copy
            .Cells(lastRow + 1, "L").PasteSpecial xlPasteValues
        End With
Range("N" & i).EntireRow.Delete Shift:=xlUp
Range("A100").EntireRow.Insert


    End If
Next i

Display More

tswood · Sep 22nd 2016

Re: Copy union / range but skip cell when pasting

Hello,

No luck with the above code unfortunately. The code seems to run without incurring any errors, however nothing copies over and the row doesn't delete.

Here is the original code I was working with prior to the changes:

Code

For i = 1 To Cells(Rows.Count, "N").End(xlUp).Row
If Cells(i, 14) = "no" Then
Range(Cells(i, 2), Cells(i, 10)).Copy
wsTarget.Range("B" & wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1).PasteSpecial (xlPasteValues)
Range("M" & i).EntireRow.Delete Shift:=xlUp
Range("A100").EntireRow.Insert
End If
Next i

It seems to be the addition of the new range to copy that is creating the issue from what I can see.

Code

Dim lastRow As Long
For i = 1 To Cells(Rows.Count, "N").End(xlUp).Row
If Cells(i, 14) = "no" Then
With wsTarget
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Range(Cells(i, 2), Cells(i, 10)).Copy
.Cells(lastRow + 1, "B").PasteSpecial xlPasteValues
Cells(i, 16).Copy
.Cells(lastRow + 1, "L").PasteSpecial xlPasteValues
End With
Range("M" & i).EntireRow.Delete Shift:=xlUp
Range("A100").EntireRow.Insert


End If
Next i

Display More

As for inserting a row at A100, this is the end of the table so it seemed appropriate to insert a row here so that it doesn't mix up the existing data.

tswood · Sep 21st 2016

Re: Copy union / range but skip cell when pasting

Thanks for this jolivanes.

I had a little trouble understanding the following:

Code

.Resize(, 9).Value = Cells(i, 2).Resize(, 9).Value
.Offset(, 10).Value = Cells(i, 2).Offset(, 13).Value

Are you possibly able to elaborate as to what is happening here?

Thanks again for your help

tswood · Sep 21st 2016

Re: Copy union / range but skip cell when pasting

Hi Luke,

Thanks for the suggestion. It worked a treat!

I have since, however, encountered another issue that I was hoping you might be able to assist with.

I am trying to add as part of the IF condition the following:

Code

Range("M" & i).EntireRow.Delete Shift:=xlUp
Range("A100").EntireRow.Insert

The problem is that as soon as I add this the macro stops working. Can you perhaps see where I have gone wrong?

Code

Dim lastRow As Long
For i = 1 To Cells(Rows.Count, "N").End(xlUp).Row
    If Cells(i, 14) = "no" Then
        With wsTarget
            lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
             
            Range(Cells(i, 2), Cells(i, 10)).Copy
            .Cells(lastRow + 1, "B").PasteSpecial xlPasteValues
            Cells(i, 16).Copy
            .Cells(lastRow + 1, "L").PasteSpecial xlPasteValues
        End With
        Range("M" & i).EntireRow.Delete Shift:=xlUp
        Range("A100").EntireRow.Insert
    End If
Next i

Display More

tswood · Sep 20th 2016

Hello,

I am trying to paste cells 2 - 10 and 15 to a new target 2 - 12. The issue I am having is that I don't actually want to paste anything in cell 11, rather 2 - 10 paste the same, skip 11, then cell 15 pastes in cell 12.

Is this possible at all? Here is what I am working with.

Code

For i = 1 To Cells(Rows.Count, "M").End(xlUp).Row
If Cells(i, 13) = "no" Then
Union(Range(Cells(i, 2), Cells(i, 10)), Cells(i, 15)).Copy
wsTarget.Range("B" & wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1).PasteSpecial (xlPasteValues)
End If




Next i

Thank-you

tswood · Sep 19th 2016

Hi,

I am trying to find a way to copy cell ranges 2 - 12 and 14 - 17 to another sheet. I can't seem to work out how to copy range 14 - 17 successfully.

The code below manages to copy range 2 - 12 and cell 14 only.

Code

For i = 1 To Cells(Rows.Count, "G").End(xlUp).Row
If Surname = vbNullString And fName = vbNullString Then
Exit Sub
ElseIf InStr(Cells(i, 6).Value, Surname) > 0 And InStr(Cells(i, 8).Value, fName) > 0 Then
Union(Range(Cells(i, 2), Cells(i, 12)), Cells(i, 14)).Copy
wsTarget.Range("B" & wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1).PasteSpecial (xlPasteValues)
Range("G" & i).EntireRow.Delete Shift:=xlUp
End If




Next i

Display More

Any assistance would be greatly appreciated.

Thank you

tswood · Sep 15th 2016

Re: Copy a range of sequential and non-sequential cells

Hello,

That works perfectly, thank you both for your suggestions.

I find it is usually the simple solution that I overlook.

Thanks

tswood · Sep 15th 2016

Hello,

In the code below, for the section that reads "Range(Cells(i, 1), Cells(i, 8)).Copy" I want to add Cells(i, 13) but can't seem to work out how.

Code

For i = 1 To Cells(Rows.Count, "G").End(xlUp).Row
If Surname = vbNullString And fName = vbNullString Then
wsTarget.Activate
Exit Sub
ElseIf InStr(Cells(i, 5).Value, Surname) > 0 And InStr(Cells(i, 7).Value, fName) > 0 Then
Range(Cells(i, 1), Cells(i, 8)).Copy
wsTarget.Range("B" & wsTarget.Cells(Rows.Count, "B").End(xlUp).Row + 1).PasteSpecial (xlPasteValues)
End If




Next i

Display More

Any suggestions?

Thanks

tswood · Jul 5th 2016

Re: Find string match in column then paste adjacent cell

Hello,

My apologies... I thought that there was a potential work-around.

I have managed to get the formula working by including the title (source) data on the active sheet (sheet 5) so that there is an intersect.

The code it very long winded though and I feel that there must be a shorter version. Also, I'm wondering it it is possible to have the code update automatically when changes are made to the 'source sheet' (sheet 1) rather than having to click on the individual cell every time to update. Is this possible?

I have included my code below for reference.

Code

Private Sub Worksheet_Change(ByVal Target As Range)




    Dim lRow As Long
    Dim Srch As String
    Dim T1 As Boolean, T2 As Boolean, T3 As Boolean, T4 As Boolean
    
If Intersect(Target, Range("U13")) Is Nothing Then Exit Sub
    
Application.ScreenUpdating = False




lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Srch = Sheet5.Range("C1").Value




For Each cell In Sheet1.Range("A2:A" & lRow)




    T1 = UCase(cell.Value) = UCase(Srch)
    T2 = UCase(cell.Value) Like UCase(Srch) & "*"
    T3 = UCase(cell.Value) Like "*" & UCase(Srch)
    T4 = UCase(cell.Value) Like "*" & UCase(Srch) & "*"




If Application.Or(T1, T2, T3, T4) Then
      cell.Offset(, 26).Copy
         Sheet5.Range("E6").PasteSpecial xlPasteValues
      cell.Offset(, 27).Copy
         Sheet5.Range("E7").PasteSpecial xlPasteValues
      cell.Offset(, 28).Copy
         Sheet5.Range("E8").PasteSpecial xlPasteValues
      cell.Offset(, 29).Copy
         Sheet5.Range("E9").PasteSpecial xlPasteValues
      cell.Offset(, 5).Copy
         Sheet5.Range("E14").PasteSpecial xlPasteValues
      cell.Offset(, 6).Copy
         Sheet5.Range("E15").PasteSpecial xlPasteValues
      cell.Offset(, 7).Copy
         Sheet5.Range("E16").PasteSpecial xlPasteValues
      cell.Offset(, 8).Copy
         Sheet5.Range("E17").PasteSpecial xlPasteValues
      cell.Offset(, 9).Copy
         Sheet5.Range("E18").PasteSpecial xlPasteValues
      cell.Offset(, 10).Copy
         Sheet5.Range("E19").PasteSpecial xlPasteValues
      cell.Offset(, 11).Copy
         Sheet5.Range("E20").PasteSpecial xlPasteValues
      cell.Offset(, 12).Copy
         Sheet5.Range("E22").PasteSpecial xlPasteValues
      cell.Offset(, 13).Copy
         Sheet5.Range("E23").PasteSpecial xlPasteValues
      cell.Offset(, 14).Copy
         Sheet5.Range("E24").PasteSpecial xlPasteValues
      cell.Offset(, 15).Copy
         Sheet5.Range("E25").PasteSpecial xlPasteValues
      cell.Offset(, 16).Copy
         Sheet5.Range("E26").PasteSpecial xlPasteValues
      cell.Offset(, 17).Copy
         Sheet5.Range("E28").PasteSpecial xlPasteValues
      cell.Offset(, 18).Copy
         Sheet5.Range("E29").PasteSpecial xlPasteValues
      cell.Offset(, 19).Copy
         Sheet5.Range("E31").PasteSpecial xlPasteValues
      cell.Offset(, 20).Copy
         Sheet5.Range("E32").PasteSpecial xlPasteValues
      cell.Offset(, 21).Copy
         Sheet5.Range("E33").PasteSpecial xlPasteValues
      cell.Offset(, 22).Copy
         Sheet5.Range("E34").PasteSpecial xlPasteValues
      cell.Offset(, 23).Copy
         Sheet5.Range("E35").PasteSpecial xlPasteValues
    End If
Next




Application.CutCopyMode = False
Application.ScreenUpdating = True




End Sub

Display More

Thank you again

tswood · Jul 4th 2016

Re: Find string match in column then paste adjacent cell

forum.ozgrid.com/index.php?attachment/69594/

I have attached a very rough version the spreadsheet I am trying to work with.

Thank you both for your suggestions.

Hopefully you will be able to see where I have gone wrong.

tswood · Jul 1st 2016

Re: Find string match in column then paste adjacent cell

also...

When I try the code below, Run-time error '424' appears 'Object required'

Code

Sub FindThings()




Application.ScreenUpdating = False




    Dim lRow As Long
    Dim Srch As String
    Dim T1 As Boolean, T2 As Boolean, T3 As Boolean, T4 As Boolean




lRow = Sheet1.Range("A" & Rows.Count).End(xlUp).Row
Srch = Sheet2.Range("C1").Value




For Each cell In Sheet1.Range("A6:A" & lRow)




    T1 = UCase(cell.Value) = UCase(Srch)
    T2 = UCase(cell.Value) Like UCase(Srch) & "*"
    T3 = UCase(cell.Value) Like "*" & UCase(Srch)
    T4 = UCase(cell.Value) Like "*" & UCase(Srch) & "*"




If Application.Or(T1, T2, T3, T4) Then
      cell.Offset(, 5).Copy
         Sheet2.Range("E14").PasteSpecial xlPasteValues
    End If
Next




Application.CutCopyMode = False
Application.ScreenUpdating = True




End Sub

Display More

The issues is arising from this line...

Code

Srch = Sheet2.Range("C1").Value

tswood · Jul 1st 2016

Re: Find string match in column then paste adjacent cell

Hi vcoolio & skywriter,

I think that I am on the same page as you now so to speak.

So there is no way to use the 'Intersect' function to reference a cell that is on a different sheet. Correct?

Currently my workbook contains the following:

Sheet 2
- Cell C1 ='Sheet 1'!A6

Sheet 3
- Cell C1 ='Sheet 1'!A7

Sheet 4
- Cell C1 ='Sheet 1'!A8

and so on...

Is there any other way I could approach this task of trying to find the relevant match on sheet 1 for each of the other sheets?

Thank you for your patience with me also.

tswood · Jun 30th 2016

Re: Find string match in column then paste adjacent cell

Hello,

I have adapted it slightly from the third suggestion vcoolio provided so that it reflects the sheet I want referenced.

thanks

tswood · Jun 30th 2016

Re: Find string match in column then paste adjacent cell

Hi vcoolio,

Thank you for your comprehensive instructions.

I'm having some issues with the following line:

Code

If Intersect(Target, Range("Budget 2016-17!A6")) Is Nothing Then Exit Sub

It keeps producing the error below:

Run-time error '1004': Method 'Range' of object '_Worksheet' failed

Can you see where I am going wrong at all?

Thanks.

Posts by tswood

Sorting cells that are both integers and decimal numbers

Code does not run when assigned to a button

Code does not run when assigned to a button

Insert and delete rows within an IF statement

Insert and delete rows within an IF statement

Insert and delete rows within an IF statement

Insert and delete rows within an IF statement

Copy union / range but skip cell when pasting

Copy union / range but skip cell when pasting

Copy union / range but skip cell when pasting

Copy union / range but skip cell when pasting

Copying multiple ranges to a new sheet sequentially

Copy a range of sequential and non-sequential cells

Copy a range of sequential and non-sequential cells

Find string match in column then paste adjacent cell

Find string match in column then paste adjacent cell

Find string match in column then paste adjacent cell

Find string match in column then paste adjacent cell

Find string match in column then paste adjacent cell

Find string match in column then paste adjacent cell