Excel VBA to copy adjacent column in different sheet based on matching criteria

Question

I have a macro to check sheet1 if the value in column A matches the value in the same column in sheet2, and if so, it copies the adjacent cell for each matched value from sheet1 into sheet2. Below is what I have so far, but I keep getting 'run time error 9' on the lastrowadd line and am not sure why. Any help would be appreciated :)

Sub CopyAdjacent()
    Dim i As Long, j As Long, colStatus As Long, lastrowAdd As Long, lastrowRemove As Long

    colStatus = 2 'your status column number
    lastrowAdd = Sheets(“Sheet1”).Cells(Sheets(“Sheet1”).Rows.Count, 1).End(xlUp).Row
    lastrowRemove = Sheets(“Sheet2”).Cells(Sheets(“Sheet2”).Rows.Count, 1).End(xlUp).Row

    For i = 1 To lastrowAdd
        For j = 1 To lastrowRemove
            If Sheets(“Sheet1”).Cells(i, 1).Value = Sheets(“Sheet2”).Cells(j, 1).Value Then
                Sheets(“Sheet2”).Cells(j, colStatus).Value = Sheets(“Sheet1”).Cells(i, colStatus).Value
            End If
        Next j
    Next i
End Sub

Sheets(“Sheet1”).Cells(Sheets(“Sheet1”).Rows.Count, 1).End(xlUp).Row Try changing this to Sheets(“Sheet1”).Rows.Count-1 and see what happen — Saechel

Moiety Design Moiety Design · Accepted Answer · 2014-08-27T23:52:26

A couple of small changes have been made including the way both lastrowAdd and lastrowRemove have been defined. I also removed i and j from the definition.

Sub CopyAdjacent()
Dim colStatus As Long, lastrowAdd As Integer, lastrowRemove As Integer

colStatus = 2
lastrowAdd = Sheets(“Sheet1”).Cells(Rows.Count, 1).End(xlUp).Row
lastrowRemove = Sheets(“Sheet2”).Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastrowAdd
    For j = 1 To lastrowRemove
        If Sheets(“Sheet1”).Cells(i, 1).Value = Sheets(“Sheet2”).Cells(j, 1).Value Then
            Sheets(“Sheet2”).Cells(j, colStatus).Value = Sheets(“Sheet1”).Cells(i, colStatus).Value
        End If
    Next
Next
End Sub

Also this isn't checking if on the same column the two are matching. It checks every column of Sheet2 against each one from Sheet1. I think the below code is what you are looking for.

Sub CopyAdjacent()
' The below line has been changed, you may still omit lastrowRemove
Dim colStatus, lastrowAdd, lastrowRemove As Integer

colStatus = 2
lastrowAdd = Sheets(“Sheet1”).Cells(Rows.Count, 1).End(xlUp).Row
' The below line is now redundant in the new code
'lastrowRemove = Sheets(“Sheet2”).Cells(Rows.Count, 1).End(xlUp).Row

For i = 1 To lastrowAdd
        If Sheets(“Sheet1”).Cells(i, 1).Value = Sheets(“Sheet2”).Cells(i, 1).Value Then
            Sheets(“Sheet2”).Cells(i, colStatus).Value = Sheets(“Sheet1”).Cells(i, colStatus).Value
        End If    
Next
End Sub

Excel VBA to copy adjacent column in different sheet based on matching criteria

1 Answers