Align multiple columns to 1

November 7, 2012 at 09:23:08
Specs: Windows XP
Hi,
I need columns B (item#) & C (item description) to stay together to match by column B (item#) to A (complete list of item#s).

How can this macro be modified to include an additional column to stay with the item#?
OR I don't mind concatenating the info first, but then they don't line up - can I modify the macro to equal or greater than?

Option Explicit
Sub Isolate()
Dim lastA, lastB, shortCol, rw As Integer
'Determine short column so we know when to stop
lastA = WorksheetFunction.CountA(Range("A:A"))
lastB = WorksheetFunction.CountA(Range("B:B"))
If lastA > lastB Then _
shortCol = 2 Else shortCol = 1
'Set First Check Row
rw = 1
nxtChk:
'Check Column A against Column B, Row by Row
'Insert cell at non-matching data
If Cells(rw, 1) <> "" And Cells(rw, 1) < Cells(rw, 2) Then
Cells(rw, 2).Insert shift:=xlDown
Else
If Cells(rw, 2) <> "" And Cells(rw, 1) > Cells(rw, 2) Then
Cells(rw, 1).Insert shift:=xlDown
End If
End If
'If there is nothing left to check in the Short Column, we're done
If Cells(Rows.Count, shortCol).End(xlUp).Row + 1 = rw Then Exit Sub
'If not, increment Row counter and loop
rw = rw + 1
GoTo nxtChk
End Sub

Thanks in advance!


See More: Align multiple columns to 1

Report •


#1
November 7, 2012 at 12:21:05
No, in Excel...
I hit Alt F11 > Insert Module, then run it using Alt F8.

Report •

#2
November 8, 2012 at 15:52:18
First, a posting tip:

Please click on the blue line at the end of this post and read the instructions on how to post VBA code in this forum. It's much easier to read when it looks like the code below.

You'll see where I made the change that you requested.

Option Explicit
Sub Isolate()
Dim lastA, lastB, shortCol, rw As Integer
'Determine short column so we know when to stop
  lastA = WorksheetFunction.CountA(Range("A:A"))
  lastB = WorksheetFunction.CountA(Range("B:B"))
    If lastA > lastB Then shortCol = 2 Else shortCol = 1
'Set First Check Row
     rw = 1
nxtChk:
'Check Column A against Column B, Row by Row
'Insert cell at non-matching data
'''''''''Include Column C at insert point
      If Cells(rw, 1) <> "" And Cells(rw, 1) < Cells(rw, 2) Then
        Range(Cells(rw, 2), Cells(rw, 3)).Insert shift:=xlDown
'''''''''
      Else
        If Cells(rw, 2) <> "" And Cells(rw, 1) > Cells(rw, 2) Then
          Cells(rw, 1).Insert shift:=xlDown
        End If
      End If
'If there is nothing left to check in the Short Column, we're done
     If Cells(Rows.Count, shortCol).End(xlUp).Row + 1 = rw Then Exit Sub
'If not, increment Row counter and loop
       rw = rw + 1
       GoTo nxtChk
End Sub

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


Report •

Related Solutions


Ask Question