CODEWITHSUNDEEP
vbaexcel
Kyle Burnett
Kyle Burnett

Reputation: 11

Excel VBA - Compare values in two columns and copy matched row to new sheet

I'm trying to compare column A in sheet2 to columnA in sheet1 and when there's a match, copy the row from sheet1 to sheet3. Here's the code I have but it's not working.

Sub compareAndCopy()

Dim lastRowE As Integer
Dim lastRowM As Integer
Dim foundTrue As Boolean

' stop screen from updating to speed things up
Application.ScreenUpdating = False

lastRowE = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row
lastRowF = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
lastRowM = Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "B").End(xlUp).Row



For i = 1 To lastRowE
foundTrue = False
For j = 1 To lastRowF

    If Sheets("Sheet2").Cells(i, 1).Value = Sheets("Sheet1").Cells(j, 1).Value Then
        'MsgBox ("didnt find string: " & Sheets("Sheet2").Cells(i, 2).value)
        Sheets("Sheet2").Rows(i).Copy Destination:= _
        Sheets("Sheet3").Rows(lastRowM + 1)

        Exit For
    End If

Next j

If Not foundTrue Then
    lastRowM = lastRowM + 1
    foundTrue = True

End If


Next i

' stop screen from updating to speed things up
Application.ScreenUpdating = True

End Sub

Upvotes: 1

Views: 3980

Answers (2)

YowE3K
YowE3K

Reputation: 23974

As pointed out by Scott Craner, your updating of lastRowM based on foundTrue is not working. foundTrue isn't really needed, as long as you update lastRowM each time you add a new row to Sheet3. I have kept it in the code in case you do want to display a message if the value isn't found.

Sub compareAndCopy()

    Dim lastRowE As Long
    Dim lastRowF As Long
    Dim lastRowM As Long
    Dim foundTrue As Boolean

    ' stop screen from updating to speed things up
    Application.ScreenUpdating = False

    lastRowE = Sheets("Sheet2").Cells(Sheets("Sheet2").Rows.Count, "A").End(xlUp).Row
    lastRowF = Sheets("Sheet1").Cells(Sheets("Sheet1").Rows.Count, "A").End(xlUp).Row
    lastRowM = Sheets("Sheet3").Cells(Sheets("Sheet3").Rows.Count, "B").End(xlUp).Row

    For i = 1 To lastRowE
        foundTrue = False
        For j = 1 To lastRowF

            If Sheets("Sheet2").Cells(i, 1).Value = Sheets("Sheet1").Cells(j, 1).Value Then
                lastRowM = lastRowM + 1
                Sheets("Sheet2").Rows(i).Copy Destination:= _
                           Sheets("Sheet3").Rows(lastRowM)
                foundTrue = True
                Exit For
            End If
        Next j
        'If Not foundTrue Then
        '    MsgBox ("didn't find string: " & Sheets("Sheet2").Cells(i, 2).value)
        'End If
    Next i

    ' stop screen from updating to speed things up
    Application.ScreenUpdating = True
End Sub

Upvotes: 2

user3598756
user3598756

Reputation: 29421

following your wording:

I'm trying to compare column A in sheet2 to columnA in sheet1 and when there's a match, copy the row from sheet1 to sheet3.

you may try this

Sub RowFinder()
    Dim sheet1Data As Variant

    With Worksheets("Sht2") '<--| reference your worksheet 2
        sheet1Data = Application.Transpose(.Range("A1", .Cells(.Rows.count, 1).End(xlUp)).Value)
    End With
    With Worksheets("Sht1") '<--| reference your worksheet 1
        With .Range("A1", .Cells(.Rows.count, "A").End(xlUp)) '<--| reference its column A cells from row 1 (header) down to last not empty one
            .AutoFilter field:=1, Criteria1:=sheet1Data, Operator:=xlFilterValues '<--| filter cells with sheet 2 column A values
            If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then Intersect(.Parent.UsedRange, .Resize(.Rows.count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow).Copy Destination:=Worksheets("Sht3").Range("A1")
        End With
        .AutoFilterMode = False
    End With
End Sub

Upvotes: 1

Related Questions