Automate Excel to shift data so the values in two rows match?Solved/Closed

Question

Hello! Please help me with this quandary for my internship. I would greatly appreciate it :) Here is my problem:
I want to match ID numbers in two columns by shifting the ID from Source 2 (and shifting its unique attributes along with it) so that it lines up in the proper row and matches the ID from Source 1. Both sources include ID numbers that the other one doesn't have. I don't want to delete those rows, but just leave the Source 2 cells that are lacking the information blank. Ideally the blank cells would be automatically highlighted. Here is what I am trying to do:

The columns read, from left to right: 
Source 1 unique attributes, ID from Source 1, ID from Source 2, Source 2 unique attributes

Before:

AA	1	   2	BA
AB	3	   3	BB
AC	5	   4	BC
AD	6	   5	BD
AE	8	   6	BE
AF	10	11	BF
AG	12	12	BG

After:

AA	1	 	
AB	3	   3	BB
AC	5	   5	BD
AD	6	   6	BE
AE	8	 	
AF	10	 	
AG	12	12	BG

Is there a command, formula, or macro you can suggest to automate this work? Otherwise I have to manually go through it. I look at "ID from Source 2" and if that doesn't match the "ID from Source 1," I delete "ID from Source 2" along with its "Source 2 unique attributes." I then shift all of the Source 2 cells up the rows and check again if the new ID matches with the ID from Source 1. If not, delete and shift the cells up again. If it is obvious I simply do not have the necessary ID from Source 2, I leave it blank and continue down the row. I need to be careful to not just keep deleting Source 2 IDs that match IDs from Source 1 in rows farther down.
Thank you for your help :)    -Emily

TrowaD · Accepted Answer

Hi Emily,

The code below will temporarily place the result in columns E and F. So make sure they are empty or else change the column references in the code.

Get back to us if further assistance is desired.

Sub RunMe()
Dim lRow, x As Long

lRow = Range("C1").End(xlDown).Row

For Each cell In Range("C2:C" & lRow)
    x = 2
    Do
        If cell.Value = Cells(x, "B").Value Then
            Range(Cells(cell.Row, "C"), Cells(cell.Row, "D")).Copy
            Cells(x, "E").PasteSpecial
        End If
        x = x + 1
    Loop Until Cells(x, "C") = vbNullString
Next cell

Range("E2:F" & lRow).Copy
Range("C2").PasteSpecial
Range("E2:F" & lRow).ClearContents

Application.CutCopyMode = False
End Sub

Best regards,
Trowa

excellenthelp · Answer

Hey Trowa!

Sorry it took a while for me to get back to you...I had to take your code and sort of "scale it up" to my actual spreadsheet. But it works great!! Thanks so much :)
I really appreciate the time and energy you put into this. You have saved us all a lot of headaches!

Thanks again,
Emily

excellenthelp · Answer

Hi Trowa!

The code you sent me works wonders on the sample spreadsheet I used for my example. 

Unfortunately, when I run the code on my actual spreadsheet (which is obviously much longer, but same format), the code stops running when it hits a unique value in the C column that it can't match up with anything in the B column. Do you know any simple way to delete the cells in C and D when it can't find its "partner"??

Thanks again for all your help!
~Emily

Automate Excel to shift data so the values in two rows match?

3 replies

Subscribe To Our Newsletter!