Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sort_Organize two lists of variables
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 |
#2
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sort_Organize two lists of variables
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 -- Dick Kusleika MVP - Excel www.dicks-clicks.com Post all replies to the newsgroup. "Hugo Ahrens" wrote in message . .. 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 |
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sort_Organize two lists of variables
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 |
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sort_Organize two lists of variables
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? ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
#5
Posted to microsoft.public.excel.programming
|
|||
|
|||
Sort_Organize two lists of variables
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 -- Dick Kusleika MVP - Excel www.dicks-clicks.com Post all replies to the newsgroup. "jdcollins21" wrote in message ... 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? ------------------------------------------------ ~~ Message posted from http://www.ExcelTip.com/ ~~ View and post usenet messages directly from http://www.ExcelForum.com/ |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
Drop down lists from multiple source lists | Excel Worksheet Functions | |||
Not at all clear on use of variables and/or object variables | Excel Discussion (Misc queries) | |||
LISTS- adding info without repeat to other lists | Excel Discussion (Misc queries) | |||
Multiple lists with repeated values for dependet drop down lists | Excel Worksheet Functions | |||
Compare two lists with two variables | Excel Worksheet Functions |