How to find, copy a different column and then paste somewhere else with multiple values-CodePudding

I am looking to search the text in first column for specific words and when they're found copy and paste the adjacent column to somewhere else.

I've got this code which works fine if the text is exactly those words but if anything else is there it fails (i.e super consolidator).

I'm still very new to VBA and have just adapted some other code to get to this point. I figure the find function would be a good way to go about it but I can't wrap my head around how to avoid the infinite loops. Any help here would be appreciated

Sub Test()
    Dim lr As Long
    Dim r As Long
    
'   Find last row in column A with data
    lr = Cells(Rows.Count, "A").End(xlUp).Row
    
'   Loop through all rows in column A
    For r = 1 To lr
'       Check value on entry
        If (Cells(r, "A") = "Super") Or (Cells(r, "A") = "Pension") Or (Cells(r, "A") = "SMSF") Then
'           Copy column B and paste in C where found
            Cells(r, "B").Select
            Selection.Copy
            ActiveCell.Offset(0, 1).PasteSpecial    
        End If
    Next r 
End Sub

CodePudding user response：

What you're looking for is called Wildcard string comparision. And you can use VBA's Like operator to achieve your output

If (Cells(r, "A") Like "Super*") Or (Cells(r, "A") Like "Pension*") Or (Cells(r, "A") Like "SMSF*") Then

Here the * in Super* means that the text should start with "Super" and it can have anything after that.
If you'd like to search if the cell contains "Super" anywhere, you can use *Super* - * at both ends of Super

CodePudding user response：

To have a more robust code I moved the "signal" words you are checking for into an array at the beginning of the sub.

Same with the column indexes of the column you want to copy and the target index.

By that it is much easier to make adjustments if the requirements change, e.g. look for a forth word etc.

Furthermore you should avoid implicit referencing cells. That's why I added the ws-variable - you have to adjust your sheet name.

Plus I added a generic function isInArray that takes the cell-value plus the array with the lookup values and returns true or false. Here the like-operator is implemented.

You don't need to select-copy/paste the values - you can simply write them to the target cell: .Cells(r, targetColumnIndex).value = .Cells(r, sourceColumnIndex).value.

But be aware: if you have a lot of data it would make more sense to load everything into an array and work on that ... but that's the next lesson to learn ;-)

Option Explicit

Public Sub copyValues()

    Dim arrLookupValues(2) As Variant
    arrLookupValues(0) = "Super"
    arrLookupValues(1) = "Pension"
    arrLookupValues(2) = "SMSF"
    
    Const sourceColumnIndex As Long = 2 'take value from column B
    Const targetColumnIndex As Long = 3 'write value to colum C
    
    application.screenupdating = false
    
    Dim lr As Long
    Dim r As Long
    
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("Sheet1")    'adjust this to your needs
    
    With ws
        lr = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        For r = 1 To lr
    '       Check value on entry
            If isInArray(.Cells(r, 1).value, arrLookupValues) Then
    '           write value of column B (2) to C (3)
                .Cells(r, targetColumnIndex).value = .Cells(r, sourceColumnIndex).value
            End If
        Next r
    End With

    application.screenupdating = true
End Sub


Private Function isInArray(value As Variant, arrLookFor As Variant) As Boolean
Dim i As Long
For i = LBound(arrLookFor) To UBound(arrLookFor)
    If value like arrLookFor(i) & "*" Then
        isInArray = True
        Exit For
    End If
Next
End Function