Aligning identical data from two columns that have different data

[jmd0103]

I have two columns:

red</SPAN>	red</SPAN>
yellow</SPAN>	blue</SPAN>
teal</SPAN>	yellow</SPAN>
black </SPAN>	black </SPAN>
green</SPAN>	green</SPAN>
pink</SPAN>	pink</SPAN>
orange</SPAN>	grey </SPAN>
grey </SPAN>	white</SPAN>
brown</SPAN>	brown</SPAN>
beige</SPAN>	purple</SPAN>
purple</SPAN>	silver</SPAN>
silver</SPAN>	maroon</SPAN>
maroon</SPAN>

<TBODY>
</TBODY>

Column 1 has some data that column 2 does not have, as column 2 has some data that column 1 does not have. Both columns are in the same order however, and they must STAY in this same order. I do not wish to put it in alphabetical order. What I would like to get out of a macro is:

red</SPAN>	red</SPAN>
	blue</SPAN>
yellow</SPAN>	yellow</SPAN>
teal </SPAN>
black </SPAN>	black </SPAN>
green</SPAN>	green </SPAN>
pink</SPAN>	pink</SPAN>
orange</SPAN>
grey </SPAN>	grey </SPAN>
	white</SPAN>
brown</SPAN>	brown</SPAN>
beige</SPAN>
purple</SPAN>	purple</SPAN>
silver</SPAN>	silver</SPAN>
maroon</SPAN>	maroon</SPAN>

<TBODY>
</TBODY>

It needs to be able to recognize the difference between having a value missing from column 1 versus having a value missing from column 2. What I am having trouble with is after finding a non-match, I need to scan BOTH columns to see whether the value is missing from 1 or 2, and shift the other column accordingly.

Any help would be GREATLY appreciated.

Thank you!

 

[jeffmb]

This should do it for you:

Sub sync_columns()
Dim rowA As Integer
Dim rowB As Integer
Dim rng As Range
    
    rowA = 1
    Do While Not IsEmpty(Range("A" & rowA))
        With Worksheets("Sheet1").Range("B:B")
            Set rng = .Find(Range("A" & rowA).Value, LookIn:=xlValues)
            If Not rng Is Nothing Then
                rowB = rng.Row
                If rowB > rowA Then
                    Range("A" & rowA & ":A" & rowB - 1).Select
                    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                    rowA = rowB
                ElseIf rowA > rowB Then
                    Range("B" & rowB & ":B" & rowA - 1).Select
                    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
                End If
            End If
            rowA = rowA + 1
        End With
    Loop
    
End Sub

 

[jmd0103]

Thank You THANK YOU!