Align 3 columns with 2 columns of matching data

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.