CODEWITHSUNDEEP
vbaexcelloops
Rhyfelwr
Rhyfelwr

Reputation: 329

Finding matching values across two sheets

Hi I am trying to write a code where checks each value in column B on Sheet1 and finds the exact matching value in column A on Sheet 2, and if a match is found then copies the entire row from Sheet 2 next to the row with the matching value on Sheet 1.

I have the following code (based on an answer I found on SO but when I try to run it it gives "Next without For" error, even though there is a "For x" to start the loop.

Public Sub test()
    Dim rng As Range
    Dim aNumber As Variant
    Dim rowNum As Long
    Dim rep As Worksheet
    Dim pwr As Worksheet

    Set rep = Sheets("REPORT")
    Set pwr = Sheets("PWRESET")

    Application.ScreenUpdating = False

    lastrow = rep.Cells(Rows.Count, "B").End(xlUp).Row
    For x = 2 To lastrow    
        aNumber = rep.Range("B" & x).Value       
        Set rng = pwr.Range("A1:A2000")

        If Not IsError(Application.Match(aNumber, rng, 0)) Then
            rowNum = Application.Match(aNumber, rng, 0)
        Else
            Next
        End If             
    Next x

    Application.ScreenUpdating = True
End Sub

Upvotes: 0

Views: 57

Answers (2)

user4039065
user4039065

Reputation:

This may be a bit closer to your goal.

Public Sub test()
    Dim x As Long
    Dim aNumber As Variant, rowNum As Variant, xfer As Variant
    Dim rng As Range, pwr As Worksheet

    Set pwr = Worksheets("PWRESET")
    Set rng = pwr.Columns(1)

    With Worksheets("REPORT")

        For x = 2 To .Cells(Rows.Count, "B").End(xlUp).row

            aNumber = .Cells(x, "B").Value
            rowNum = Application.Match(aNumber, rng, 0)
            If Not IsError(rowNum) Then
                With pwr
                    xfer = .Range(.Cells(rowNum, "A"), .Cells(rowNum, .Columns.Count).End(xlToLeft)).Value
                End With
                .Cells(x, "C").Resize(UBound(xfer, 1), UBound(xfer, 2)) = xfer
            End If

        Next x

    End With

End Sub

Upvotes: 2

Mentos
Mentos

Reputation: 1202

Removing the Else Next

Public Sub test()
    Dim rng As Range
    Dim aNumber As Variant
    Dim rowNum As Long
    Dim rep As Worksheet
    Dim pwr As Worksheet

    Set rep = Sheets("REPORT")
    Set pwr = Sheets("PWRESET")

    Application.ScreenUpdating = False

    lastrow = rep.Cells(Rows.Count, "B").End(xlUp).Row
    For x = 2 To lastrow    
        aNumber = rep.Range("B" & x).Value       
        Set rng = pwr.Range("A1:A2000")

        If Not IsError(Application.Match(aNumber, rng, 0)) Then
            rowNum = Application.Match(aNumber, rng, 0)
        End If
    'If your condition is not matched, your code will move on either way... you almost had it ;)         
    Next x

    Application.ScreenUpdating = True
End Sub

Upvotes: 1

Related Questions