Align 3 columns with 2 columns of matching data

**bearnbillie** · 02-03-2012, 04:47 PM

I have a 3 column worksheet, that two columns need to be matched and a space added if no match, and the 3rd column is tied into the 2nd column, and needs to stay with it if moved. I have searched for something like this, and only found one with the 2 column align and match. Here's the code for the 2 column one, and I need it to take the 3rd column and tie it too the 2nd and move that one as well when any column moves. Here is the code I already have:

[code]

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 = 2
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
[code\]

**stanleydgromjr** · 02-03-2012, 08:36 PM

bearnbillie,

Welcome to the Excel Forum.

Detach/open workbook AlignAtoBC - bearnbillie - EF812811 - SDG15.xls and run the AlignAtoBC macro.

If you want to use the macro on another workbook:

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Option Explicit
Sub AlignAtoBC()
' stanleydgromjr, 02/03/2012
' http://www.excelforum.com/excel-programming/812811-align-3-columns-with-2-columns-of-matching-data.html
'
' This macro was modified from code by:
' Krishnakumar, 12/12/2010
' http://www.ozgrid.com/forum/showthread.php?t=148881
'
Dim ws As Worksheet
Dim lr As Long, a As Long, ItemCode As Range
Application.ScreenUpdating = False
Set ws = Worksheets("Sheet1")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Set ItemCode = Range("A2:B" & lr)
a = 2
Do While ItemCode.Cells(a, 1) <> ""
  If ItemCode.Cells(a, 1).Offset(, 1) <> "" Then
    If ItemCode.Cells(a, 1) < ItemCode.Cells(a, 1).Offset(, 1) Then
      ItemCode.Cells(a, 1).Offset(, 1).Resize(, 2).Insert -4121
    ElseIf ItemCode.Cells(a, 1) > ItemCode.Cells(a, 1).Offset(, 1) Then
      ItemCode.Cells(a, 1).Resize(, 1).Insert -4121
      lr = lr + 1
      Set ItemCode = ws.Range("A3:C" & lr)
    End If
  End If
  a = a + 1
Loop
Application.ScreenUpdating = True
End Sub

Then run the AlignAtoBC macro.

**stanleydgromjr** · 02-04-2012, 08:33 AM

bearnbillie,

I forgot to check and sort your data, first by column A ascending, and then column B and C ascending.

Detach/open workbook AlignAtoBC - bearnbillie - EF812811 - SDG15.xls and run the AlignAtoBC macro.

If you want to use the macro on another workbook:

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

1. Copy the below code, by highlighting the code and pressing the keys CTRL + C
2. Open your workbook
3. Press the keys ALT + F11 to open the Visual Basic Editor
4. Press the keys ALT + I to activate the Insert menu
5. Press M to insert a Standard Module
6. Where the cursor is flashing, paste the code by pressing the keys CTRL + V
7. Press the keys ALT + Q to exit the Editor, and return to Excel
8. To run the macro from Excel, open the workbook, and press ALT + F8 to display the Run Macro Dialog. Double Click the macro's name to Run it.


Option Explicit
Sub AlignAtoBC()
' stanleydgromjr, 02/04/2012
' http://www.excelforum.com/excel-programming/812811-align-3-columns-with-2-columns-of-matching-data.html
'
' This macro was modified from code by:
' Krishnakumar, 12/12/2010
' http://www.ozgrid.com/forum/showthread.php?t=148881
'
Dim ws As Worksheet
Dim lr As Long, a As Long, ItemCode As Range
Application.ScreenUpdating = False
Set ws = Worksheets("Sheet1")
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
ws.Range("A2:A" & lr - 1).Sort key1:=Range("A2"), order1:=1
lr = ws.Range("B" & Rows.Count).End(xlUp).Row
ws.Range("B2:C" & lr).Sort key1:=Range("B2"), order1:=1
lr = ws.Range("A" & Rows.Count).End(xlUp).Row
Set ItemCode = Range("A2:B" & lr)
a = 2
Do While ItemCode.Cells(a, 1) <> ""
  If ItemCode.Cells(a, 1).Offset(, 1) <> "" Then
    If ItemCode.Cells(a, 1) < ItemCode.Cells(a, 1).Offset(, 1) Then
      ItemCode.Cells(a, 1).Offset(, 1).Resize(, 2).Insert -4121
    ElseIf ItemCode.Cells(a, 1) > ItemCode.Cells(a, 1).Offset(, 1) Then
      ItemCode.Cells(a, 1).Resize(, 1).Insert -4121
      lr = lr + 1
      Set ItemCode = ws.Range("A3:C" & lr)
    End If
  End If
  a = a + 1
Loop
Application.ScreenUpdating = True
End Sub

Then run the AlignAtoBC macro.