Sort_Organize two lists of variables

[Hugo Ahrens]

I wonder if someone can help me with a VBA solution to this. I have two sets
of data organized in alphabetical order by tags:
Set 1:
Adcel xx yy
Bcom xx yy
Evcal xx yy
Dmark xx yy
Fcell xx yy
Kmill xx yy
Starp xx yy

Set 2:
Adcel mm nn
Evcal mm nn
Fcell mm nn
Gcar mm nn
Hmar mm nn
Starp mm nn
What I would like as a result of the VBA code is a side by side comparing of
the two sets such that the identical tags with their respective data end up
on the same line for easy viewing/comparing:

Set 1: Set2:
Adcel xx yy Adcel mm nn
Bcom xx yy
Evcal xx yy Evcal mm nn
Dmark xx yy
Fcell xx yy Fcell mm nn
Gcar mm nn
Hmar mm nn
Kmill xx yy
Starp xx yy Starp mm nn

Thanks for

 

[Dick Kusleika]

Hugo

This appears to work. Change the range references as appropriate.

Sub comparelists()

Dim Rng1 As Range, Rng2 As Range
Dim RwNum As Long
Const ColNum As Long = 10
Dim cell1 As Range, cell2 As Range
Dim UsedRow As Long

Set Rng1 = Sheet1.Range("a1:c7")
Set Rng2 = Sheet1.Range("e1:g6")
RwNum = 2

For Each cell1 In Rng1.Columns(1).Cells
For Each cell2 In Rng2.Columns(1).Cells
If cell2 <= cell1 Then
Sheet1.Cells(RwNum, ColNum + Rng1.Columns.Count + 1) _
.Resize(, Rng2.Columns.Count).Value = _
Intersect(Rng2, cell2.EntireRow).Value

UsedRow = UsedRow + 1
If cell2 < cell1 Then
RwNum = RwNum + 1
End If
End If
Next cell2

If Rng2.Rows.Count > UsedRow Then
Set Rng2 = Rng2.Offset(UsedRow) _
.Resize(Rng2.Rows.Count - UsedRow)
UsedRow = 0
End If

Sheet1.Cells(RwNum, ColNum).Resize(, Rng1.Columns.Count) _
.Value = Intersect(Rng1, cell1.EntireRow).Value
RwNum = RwNum + 1

Next cell1

End Sub

 

[Hugo Ahrens]

Thanks very much Dick!
A quick test shows it works for me. Now over the weekend I'll try to expand
your code to compare the larger data sets. Thanks again.

Hugo

 

[jdcollins21]

I used this macro two solve a similar problem but still have an issue.
In my 2nd(smaller list), I have unique entries. Is there a way to move
these to the bottom of the newer sorted list?

 

[Dick Kusleika]

jd

Try this

Sub comparelists2()

Dim Rng1 As Range, Rng2 As Range
Dim RwNum As Long
Const ColNum As Long = 10
Dim cell1 As Range, cell2 As Range
Dim UsedRow As Long
Dim SecCol As Boolean

Set Rng1 = Sheet1.Range("a1:c7")
Set Rng2 = Sheet1.Range("e1:g6")
RwNum = 2

For Each cell1 In Rng1.Columns(1).Cells
Sheet1.Cells(RwNum, ColNum).Resize(, Rng1.Columns.Count) _
.Value = Intersect(Rng1, cell1.EntireRow).Value

For Each cell2 In Rng2.Columns(1).Cells
If cell1.Value = cell2.Value Then
Sheet1.Cells(RwNum, ColNum + Rng1.Columns.Count + 1) _
.Resize(, Rng2.Columns.Count).Value = _
Intersect(Rng2, cell2.EntireRow).Value
RwNum = RwNum + 1
SecCol = True
End If
Next cell2

RwNum = RwNum + Abs(CLng(Not SecCol))
SecCol = False
Next cell1

For Each cell2 In Rng2.Columns(1).Cells
If Rng1.Find(cell2.Value, , , xlWhole) Is Nothing Then
Sheet1.Cells(RwNum, ColNum + Rng1.Columns.Count + 1) _
.Resize(, Rng2.Columns.Count).Value = _
Intersect(Rng2, cell2.EntireRow).Value
RwNum = RwNum + 1
End If
Next cell2

End Sub