Solved Two long sorted columns. Macro/VBA to line them up.

Microsoft Excel 2013 32/64-bit - license...
August 26, 2013 at 10:33:31
Specs: Windows 8
Good day all,
I have two long, sorted sets of data columns {A,B,C} in set one and {D,E,F} in set two.
I need to line up set 2 with set 1 where D = A.
If there is no A for D, then the row {D,E,F} must be inserted between rows in set 1 {A,B,C} where A<D and A>D.

ex:

************** INITIAL DATA *************
A B C D E F

1 1001 Mike Smith 1210 Steve Jenkins
2 1001 Mike Smith 1300 Mary Maxis
3 1210 Steve Jenkins 1425 Joe Schmoe
4 1295 Michelle Soave 1425 Joe Schmoe
5 1500 Keith Clark 1480 Harold Ezelle
6 1500 Keith Clark 1500 Keith Clark

************** END RESULT *************
A B C D E F

1 1001 Mike Smith
2 1001 Mike Smith
3 1210 Steve Jenkins 1210 Steve Jenkins
4 1295 Michelle Soave
5 1300 Mary Maxis
6 1425 Joe Schmoe
7 1425 Joe Schmoe
8 1480 Harold Ezelle
9 1500 Keith Clark 1500 Keith Clark
10 1500 Keith Clark

[/pre]

I use hundreds of lines of data so you can guess I cut a lot of manual data movements. Any help will be GREATLY appreciated ! ;)

message edited by GregM56


See More: Two long sorted columns. Macro/VBA to line them up.

Report •


✔ Best Answer
August 30, 2013 at 12:01:12
OK, I think I got it. I used your original data set and extended it, trying different lengths of data in Column A and D, adding data to both A:C and D:F, etc. The code seems to work for everything that I tested, but the true test will be your actual data.

Figuring out how to deal with data in Columns A:C when it didn't appear in D:F and keeping everything in numerical order was a bit of a challenge, but through lots of trial and error I think I got it.

I tried to put enough comments in the code to give you an idea of what's going on, but it may still need some explaining, so don't hesitate to ask. I'll be traveling next week and don't really know what my schedule will be like, so rapid responses are unlikely.
Remember to use this debugging tutorial to help you figure out what the code is doing.

http://www.computing.net/howtos/sho...

Sub LineUpData()
'Comment out the following line to watch the code fill in the sheet as it runs.
 Application.ScreenUpdating = False
'Determine last Row with data in Sheet 1 Column A and Column D
  lastA_Rw = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
  lastD_Rw = Sheets(1).Range("D" & Rows.Count).End(xlUp).Row
'Clear Sheet2 and Copy Original data from Sheet1 Columns A:C
  Sheets(2).Cells.ClearContents
  Sheets(1).Range("A1:C" & lastA_Rw).Copy _
     Destination:=Sheets(2).Range("A1")
'Search Sheet2 Column A for values from Sheet1 Column D
    With Sheets(2).Range("A1:A" & lastA_Rw)
     For nxtRw = 1 To lastD_Rw
       Set c = .Find(Sheets(1).Cells(nxtRw, "D"))
'** If value is found...
        If Not c Is Nothing Then
'Save found Row for later use
          dstRw = c.Row
'Copy Sheet1 Columns D:F to Sheet2 Row where value was found
          Sheets(1).Range(Cells(nxtRw, "D"), Cells(nxtRw, "F")).Copy _
            Destination:=Sheets(2).Cells(c.Row, "D")
'** If value isn't found...
        Else
'Determine if value in Column A is less than Column D
          If Sheets(2).Cells(dstRw + 1, "A") <> "" And _
             Sheets(2).Cells(dstRw + 1, "A") < Sheets(1).Cells(nxtRw, "D") Then
'If it is...
'   1 - Increment the destination row
             dstRw = dstRw + 1
'   2 - Set myFlag so we know not to copy data from Columns D:F
             myFlag = 1
'   3 - Decrement nxtRw so we don't lose our place in Column D
             nxtRw = nxtRw - 1
         End If
'Determine if myFlag is set.
'If not, it's OK to insert a Row and copy data to new row
           If myFlag <> 1 Then
             Sheets(2).Cells(dstRw + 1, "A").EntireRow.Insert
'Increment row Counter
               dstRw = dstRw + 1
'Copy Sheet1 Columns D:F to new row on Sheet2
             Sheets(1).Range(Cells(nxtRw, "D"), Cells(nxtRw, "F")).Copy _
                Destination:=Sheets(2).Cells(dstRw, "D")
           End If
'Reset myFlag
         myFlag = 0
       End If
    Next
 End With
End Sub


Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03



#1
August 28, 2013 at 06:24:16
Hello friends,

Since I haven't had any responses to this challenge, maybe someone can tell me why. Have I presented an impossible task? Have I presented it incorrectly? Have I failed to follow a specific protocol? Do I need to clarify the question? I certainly have ever intention of doing this correctly.

What I provided using the titles INITIAL DATE / END RESULT is the before calculation and the desired result. Of course the desired result was done by proverbial hand, which doesn't work well for hundreds of lines of data.

I have tried multiple ways to go about this, but without VBA help. I inserted a column in front of each set and filled the cells in front of set 1 with a 1 and those before set 2 with a 2 to identify their original sets. Next, I copied them to another location and placed set 2 below set 1 and sorted them. Then, in the three cells to the right of this copied range, I placed a script to read: IF($S22=2,"",T22) [ and the same for U22 & V22 ] to capture the set 1 data, and placed another script in the three cells to the right of that (IF(AND($S23=2,$T23=$T22),T23,IF(AND($S22=2,T22=T21,$S21<>2),"",IF($S22=2,T22,"")) to capture the set 2 data.

That gets most of the work done, but I still have to go back line-by-line and tweak it because there are various scenarios where the data does not line up properly.

So, that's where my visit to you guys (and gals) comes in. So, given what we now know, is there anyone that can help me simplify the task?

Thanks in advance, I appreciate your consideration.


Report •

#2
August 28, 2013 at 09:27:35
You have done most of the work, so see if this helps.

Next, I copied them to another location and placed set 2 below set 1 and sorted them.

This is where I started, I sorted on the ID number.
So with your data like:

    A     B      C         D
 1)    << Leave Row Blank >>
 2) 1   1001   Mike      Smith
 3) 1   1001   Mike      Smith
 4) 1   1210   Steve     Jenkins
 5) 2   1210   Steve     Jenkins
 6) 1   1295   Michelle  Soave
 7) 2   1300   Mary      Maxis
 8) 2   1425   Joe       Schmoe
 9) 2   1425   Joe       Schmoe
10) 2   1480   Harold    Ezelle
11) 1   1500   Keith     Clark
12) 1   1500   Keith     Clark
13) 2   1500   Keith     Clark

NOTE: Row 1 is left blank to avoid the formula throwing up an error message.

NOTE: I have concatenated the formulas, you can use the Text to Column function to separate out the data when your done.

In Column E Cell 2 enter the formula:

=IF(A2=1,A2&" "&B2&" "&C2&" "&D2,"")

Drag down as many rows as neeeded.

In Column F Cell 2 enter the formula:

=IF(AND(A2=1,A3=2,B2=B3),A3&" "&B3&" "&C3&" "&D3,IF(AND(A2=2,A1=1,B2=B1),"",IF(A2=2,A2&" "&B2&" "&C2&" "&D2,"")))

Drag down as many rows as needed.

Your data should now look like:

    A     B      C         D                E                     F
 1)    << Leave Row Blank >> 
 2) 1   1001   Mike      Smith      1 1001 Mike Smith       
 3) 1   1001   Mike      Smith      1 1001 Mike Smith       
 4) 1   1210   Steve     Jenkins    1 1210 Steve Jenkins    2 1210 Steve Jenkins
 5) 2   1210   Steve     Jenkins                    
 6) 1   1295   Michelle  Soave      1 1295 Michelle Soave   
 7) 2   1300   Mary      Maxis                              2 1300 Mary Maxis
 8) 2   1425   Joe       Schmoe                             2 1425 Joe Schmoe
 9) 2   1425   Joe       Schmoe                             2 1425 Joe Schmoe
10) 2   1480   Harold    Ezelle                             2 1480 Harold Ezelle
11) 1   1500   Keith     Clark      1 1500 Keith Clark      
12) 1   1500   Keith     Clark      1 1500 Keith Clark      2 1500 Keith Clark
13) 2   1500   Keith     Clark                      

Now, just copy your new data, Columns E & F, to someplace safe and delete the blank rows.

It is not exactly the same as your example, but I think it's pretty close and should work.

MIKE

http://www.skeptic.com/

message edited by mmcconaghy


Report •

#3
August 28, 2013 at 13:16:17
Hello Mike,

Thank you very much for looking at this for me. My result came out like yours did. One I haven't been able to solve is that, for example, column F12 should line up with E11, instead of the second instance, E12.

But, the biggest thing, and I obviously failed to be clear, is that I wanted to learn to do this in VBA. Reading back through what I said and my title, I realize I only mentioned VBA without being specific -- my bad.

I tried to run a macro and then learn from the VBA code, but that didn't work out exactly, likely I suppose because I had to do so many different things. Given what you obviously know and can see here, do you think this is not the sort of task that I should want a VBA script to do for me?

Again, thanks for your assistance.

~Greg


Report •

Related Solutions

#4
August 28, 2013 at 14:05:00
I wanted to learn to do this in VBA.

Sorry, my VBA skills are just above nill.

But, if you have some code, post what you have and
perhaps you'll get some assistance.

MIKE

http://www.skeptic.com/


Report •

#5
August 28, 2013 at 16:35:54
Okay, thanks Mike.
I wonder if there's anyone out there that knows VBA and is willing to consider this...

Report •

#6
August 28, 2013 at 18:48:41
I thought I had some VBA worked out, but it didn't produce the exact results you wanted. It worked for the finding the numbers shown in Column E and lining them up with the numbers in Column A, and inserting the blanks cells, but it didn't work for numbers in Column A that weren't found in Column E.

In other words, 1295 Michelle Soave ended up after the blank cells that were inserted in Columns A:C instead of before them. It's going to take a little time to figure how to make it "do both". Unfortunately, my free time is next to non-existent this week and next week I'll be on vacation without access to a machine that runs Excel.

I'll try to work on this but I make no promises.

BTW..I'm not sure why you marked Mike's answer as the Best Answer. I'm not disparaging Mike's solution, but if it's not what you are looking for, marking the thread as Solved might prevent others from looking at it and offering a VBA based solution. I have reset the Best Answer for the time being.

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#7
August 28, 2013 at 20:28:52
Thanks for your help and advice. I used the tags, but I s'pose that I should have used tabs instead of spaces. I went ahead with the Best because I was getting emails telling me that I failed to make the Best choice and needed to do it and since Mike's was the only, I went ahead and did it.

Hope you have a great vacation. I'm looking forward to seeing your code as I'm anxious to use your code to better learn VBA to actually solve problems. Thanks again for any time you can spare in this effort.

If you're up to it, I welcome you to talk me thru your thought process (in notes) as you're putting the code together so I can better learn to 'think out' the problem solving approach you take. I'm sure others reading and learning will also love to take advantage of the lesson.

message edited by GregM56


Report •

#8
August 29, 2013 at 04:01:25
If I get a chances I'll clean up what I have and add comments so you can see what I'm trying to do. In the meantime, you might want to review this How-To.

These debugging techniques really helped me when I first started writing VBA code.

http://www.computing.net/howtos/sho...

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#9
August 29, 2013 at 06:43:39
Here's the code I have so far.

I had to make a few assumptions:

1 - Your original data resides in Sheet1
2 - Sheet2 is empty and available as the depository of the newly formatted data (see my caution below)
3 - You have no data in Sheet1 Column A below the data that we are trying to line up.

As I said, the code only does part of the job. The results look like what I've pasted below, with the "1295" data ending up in the wrong row because the code only searches Column A for Column D data when it really has to search Column D for Column A data also in order to keep the numerical data in order. I need to figure out a way to tell the code that if a value exists in Colmn A that is not in Column D, then it has to place that data in the correct row based on it's numerical value. In other words, it's not just a matter of using .Find to match values in D and A, we also have to deal with "greater than" and "less than" in order to maintain the sequence.

A word of caution: As written, the code clears Sheet2 and uses it as the depository for the newly formatted data. If you have data that you need in Sheet2, then you should either modify the code to use a different sheet or move your Sheet2 data to someplace else.

Sub LineUpData()
'Determine last Row with data in Sheet 1 Column A
  lastRw = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
'Clear Sheet2 and Copy Original data from Sheet1 Columns A:C
  Sheets(2).Cells.ClearContents
  Sheets(1).Range("A1:C" & lastRw).Copy _
     Destination:=Sheets(2).Range("a1")
'Search Sheet2 Column A for values from Sheet1 Column D
    With Sheets(2).Range("A1:A" & lastRw)
     For nxtRw = 1 To lastRw
      Set c = .Find(Sheets(1).Cells(nxtRw, "D"))
'** If value is found...
       If Not c Is Nothing Then
'Save found Row for later use
         dstRw = c.Row
'Copy Sheet1 Columns D:F to Sheet2 Row where value was found
         Sheets(1).Range(Cells(nxtRw, "D"), Cells(nxtRw, "F")).Copy _
           Destination:=Sheets(2).Cells(c.Row, "D")
'** If value isn't found...
       Else
'Insert a new row
         Sheets(2).Cells(dstRw + 1, "A").EntireRow.Insert
'Increment row Counter
           dstRw = dstRw + 1
'Copy Sheet1 Columns D:F to new row on Sheet2
         Sheets(1).Range(Cells(nxtRw, "D"), Cells(nxtRw, "F")).Copy _
         Destination:=Sheets(2).Cells(dstRw, "D")
       End If
    Next
 End With
End Sub

   	 A	 B	  C	 D	 E	 F
1	1001	Mike	Smith			
2	1001	Mike	Smith			
3	1210	Steve	Jenkins	1210	Steve	Jenkins
4				1300	Mary	Maxis
5				1425	Joe	Schmoe
6				1425	Joe	Schmoe
7				1480	Harold	Ezelle
8	1295	Michelle	Soave			
9	1500	Keith	Clark	1500	Keith	Clark
10	1500	Keith	Clark			

Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.


Report •

#10
August 29, 2013 at 08:39:55
Thanks Dad03 . . . this is one heckofa start and helps me understand it much better than before I met you. *takes a lot of thinkin' power*

Report •

#11
August 30, 2013 at 12:01:12
✔ Best Answer
OK, I think I got it. I used your original data set and extended it, trying different lengths of data in Column A and D, adding data to both A:C and D:F, etc. The code seems to work for everything that I tested, but the true test will be your actual data.

Figuring out how to deal with data in Columns A:C when it didn't appear in D:F and keeping everything in numerical order was a bit of a challenge, but through lots of trial and error I think I got it.

I tried to put enough comments in the code to give you an idea of what's going on, but it may still need some explaining, so don't hesitate to ask. I'll be traveling next week and don't really know what my schedule will be like, so rapid responses are unlikely.
Remember to use this debugging tutorial to help you figure out what the code is doing.

http://www.computing.net/howtos/sho...

Sub LineUpData()
'Comment out the following line to watch the code fill in the sheet as it runs.
 Application.ScreenUpdating = False
'Determine last Row with data in Sheet 1 Column A and Column D
  lastA_Rw = Sheets(1).Range("A" & Rows.Count).End(xlUp).Row
  lastD_Rw = Sheets(1).Range("D" & Rows.Count).End(xlUp).Row
'Clear Sheet2 and Copy Original data from Sheet1 Columns A:C
  Sheets(2).Cells.ClearContents
  Sheets(1).Range("A1:C" & lastA_Rw).Copy _
     Destination:=Sheets(2).Range("A1")
'Search Sheet2 Column A for values from Sheet1 Column D
    With Sheets(2).Range("A1:A" & lastA_Rw)
     For nxtRw = 1 To lastD_Rw
       Set c = .Find(Sheets(1).Cells(nxtRw, "D"))
'** If value is found...
        If Not c Is Nothing Then
'Save found Row for later use
          dstRw = c.Row
'Copy Sheet1 Columns D:F to Sheet2 Row where value was found
          Sheets(1).Range(Cells(nxtRw, "D"), Cells(nxtRw, "F")).Copy _
            Destination:=Sheets(2).Cells(c.Row, "D")
'** If value isn't found...
        Else
'Determine if value in Column A is less than Column D
          If Sheets(2).Cells(dstRw + 1, "A") <> "" And _
             Sheets(2).Cells(dstRw + 1, "A") < Sheets(1).Cells(nxtRw, "D") Then
'If it is...
'   1 - Increment the destination row
             dstRw = dstRw + 1
'   2 - Set myFlag so we know not to copy data from Columns D:F
             myFlag = 1
'   3 - Decrement nxtRw so we don't lose our place in Column D
             nxtRw = nxtRw - 1
         End If
'Determine if myFlag is set.
'If not, it's OK to insert a Row and copy data to new row
           If myFlag <> 1 Then
             Sheets(2).Cells(dstRw + 1, "A").EntireRow.Insert
'Increment row Counter
               dstRw = dstRw + 1
'Copy Sheet1 Columns D:F to new row on Sheet2
             Sheets(1).Range(Cells(nxtRw, "D"), Cells(nxtRw, "F")).Copy _
                Destination:=Sheets(2).Cells(dstRw, "D")
           End If
'Reset myFlag
         myFlag = 0
       End If
    Next
 End With
End Sub


Click Here Before Posting Data or VBA Code ---> How To Post Data or Code.

message edited by DerbyDad03


Report •

#12
August 30, 2013 at 21:58:33
Thank you very much for all the time and effort you've extended me and my task. You're efforts will go a long way in my coding future.

I'll give it a full test and give you some final feedback.

Hope you have a great trip!


Report •

Ask Question