Compare a row of cells to another worksheet and copy data depending on cell match

ikith · Jun 27th 2013

What I'm trying to do is make a script that depending on what button pressed will compare a row on two sheets (For example rocketOld and rocketNew) then depending on if it finds a match will copy data from rocketOld to rocketNew from one cell to the right of the compared row to the right side of the row that was matched.

I've tried googling around to find a script similar that I can adapt but no luck.

yegarboy · Jun 27th 2013

Re: Compare a row of cells to another worksheet and copy data depending on cell match

Can you upload a sample book please?

Cheers

ikith · Jun 27th 2013

Re: Compare a row of cells to another worksheet and copy data depending on cell match

Sample attached

yegarboy · Jun 27th 2013

Re: Compare a row of cells to another worksheet and copy data depending on cell match

I will have a look and return later

yegarboy · Jun 27th 2013

Re: Compare a row of cells to another worksheet and copy data depending on cell match

Can you clarify your request a bit? Does the entire row have to match?

ikith · Jun 27th 2013

Re: Compare a row of cells to another worksheet and copy data depending on cell match

No the entire row doesn't need to match, just the serial number.

So what is supposed to happen is if a serial number on rocketNew matches a serial number on rocketOld copy the CEMS ID over to rocketNew.

Edit: I phrased that wrong, it should only be checking the serial numbers, even if there is data that is the same in the row, I only want it to check serial numbers because the other data will change.

Edit2: So I've kinda adapted this script to highlight what it finds as matches from rocketOld to rocketNew possible to adapt this to look once cell over from the matches and paste the CEMS ID to rocketNew instead of highlighting?

Code

Private Sub closeButton_Click()
    Unload Me
End Sub




Private Sub rocketButton_Click()




    Dim myRng As Range
    Dim lastCell As Long




    'Get the last row
    Dim lastRow As Integer
    lastRow = ActiveSheet.UsedRange.Rows.Count




    'Debug.Print "Last Row is " & lastRow




    Dim c As Range
    Dim d As Range




    Application.ScreenUpdating = False




    For Each c In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
        For Each d In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
            If (InStr(1, d, c, 1) > 0) Then
                c.Interior.Color = vbRed
                Exit For
            End If
        Next
    Next




'    For Each c In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
'        For Each d In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
'            If (InStr(1, d, c, 1) > 0) Then
'                c.Interior.Color = vbRed
'                Exit For
'            End If
'        Next
'    Next




Application.ScreenUpdating = True




End Sub

Display More

ikith · Jun 29th 2013

Re: Compare a row of cells to another worksheet and copy data depending on cell match

Modified my code a little, it's actually not working gives an error of:
Run-time error '1004':

Method 'Range' of object '_Global' failed

Code is now:

Code

Private Sub rocketButton_Click()


    Dim myRng As Range
    Dim lastCell As Long




    'Get the last row
    Dim lastRow As Integer
    lastRow = ActiveSheet.UsedRange.Rows.Count




    'Debug.Print "Last Row is " & lastRow




    Dim c As Range
    Dim d As Range
    Dim CP As Range




    Application.ScreenUpdating = False
    
    For Each CP In Worksheets("rocketOld").Range("E3:D" & lastRow).Cells
        For Each c In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
            For Each d In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
                If (InStr(1, d, c, 1) > 0) Then
                Range("CP").Select
                Worksheets("rocketNew").Select
                ActiveSheet.Paste
                Exit For
            End If
            Next
        Next
    Next




'    For Each c In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
'        For Each d In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
'            If (InStr(1, d, c, 1) > 0) Then
'                c.Interior.Color = vbRed
'                Exit For
'            End If
'        Next
'    Next




Application.ScreenUpdating = True




End Sub

Display More

ikith · Jun 29th 2013

Re: Compare a row of cells to another worksheet and copy data depending on cell match

Actually solved this, sorry for not editing, will post final code tomorrow.

ikith · Jun 29th 2013

Re: Compare a row of cells to another worksheet and copy data depending on cell match

Code

Private Sub rocketButton_Click()


    Dim myRng As Range
    Dim lastCell As Long




    'Get the last row
    Dim lastRow As Integer
    lastRow = ActiveSheet.UsedRange.Rows.Count




    'Debug.Print "Last Row is " & lastRow




    Dim c As Range
    Dim d As Range








    Application.ScreenUpdating = False
    
        For Each c In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
            For Each d In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
                If (InStr(1, d, c, 1) > 0) Then
                c.Offset(0, 1).Copy
                d.Offset(0, 1).PasteSpecial
                Exit For
            End If
        Next
    Next




'    For Each c In Worksheets("rocketNew").Range("D3:D" & lastRow).Cells
'        For Each d In Worksheets("rocketOld").Range("D3:D" & lastRow).Cells
'            If (InStr(1, d, c, 1) > 0) Then
'                c.Interior.Color = vbRed
'                Exit For
'            End If
'        Next
'    Next




Application.ScreenUpdating = True




End Sub

Display More

Compare a row of cells to another worksheet and copy data depending on cell match

Participate now!

Share