I am trying to sort two columns so the data in both of them line up. For
example column a will have a, b, c, d, e, f and so on in it. Column B will
have a, c,e, f, but missing some of the letters that are in a. How do I line
up both of these columns so a lines up with a and b lines up with b and so
on. Where there is not a match in both it leave a blank in the second column.

Thank You For Your Help
Jeremy

I saved this from a previous post.

Option Explicit
Sub testme()

Application.ScreenUpdating = False

Dim wks As Worksheet
Dim ColA As Range
Dim ColB As Range
Dim iRow As Long
Dim myCols As Long

Set wks = Worksheets("sheet1")
wks.DisplayPageBreaks = False
With wks
'row 1 has headers!
Set ColA = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
Set ColB = .Range("b2", .Cells(.Rows.Count, "B").End(xlUp))

With ColA
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

'change the mycols to the number of columns that
'are associated with column B

myCols = 1 ' columns B only
With ColB.Resize(, myCols)
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

iRow = 2
Do
If Application.CountA(.Cells(iRow, "A").Resize(1, 2)) = 0 Then
Exit Do
End If

If .Cells(iRow, "A").Value = .Cells(iRow, "B").Value _
Or Application.CountA(.Cells(iRow, "A").Resize(1, 2)) = 1 Then
'do nothing
Else
If .Cells(iRow, "A").Value .Cells(iRow, "B").Value Then
.Cells(iRow, "A").Insert shift:=xlDown
Else
.Cells(iRow, "B").Resize(1, myCols).Insert shift:=xlDown
End If
End If
iRow = iRow + 1
Loop
End With

Application.ScreenUpdating = True

End Sub



Jeremy wrote:

I am trying to sort two columns so the data in both of them line up. For
example column a will have a, b, c, d, e, f and so on in it. Column B will
have a, c,e, f, but missing some of the letters that are in a. How do I line
up both of these columns so a lines up with a and b lines up with b and so
on. Where there is not a match in both it leave a blank in the second column.

Thank You For Your Help
Jeremy

--

Dave Peterson

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm

Jeremy wrote:

I am trying to sort two columns so the data in both of them line up. For
example column a will have a, b, c, d, e, f and so on in it. Column B will
have a, c,e, f, but missing some of the letters that are in a. How do I line
up both of these columns so a lines up with a and b lines up with b and so
on. Where there is not a match in both it leave a blank in the second column.

Thank You For Your Help
Jeremy

--

Dave Peterson

I tried pasting this in visual basic editor and it did not work. I set up
column a with a, b, c, d, e and b with a, c, e and it did not move the
placement to align the letters in both columns. Any Ideas?

"Dave Peterson" wrote:

I saved this from a previous post.

Option Explicit
Sub testme()

Application.ScreenUpdating = False

Dim wks As Worksheet
Dim ColA As Range
Dim ColB As Range
Dim iRow As Long
Dim myCols As Long

Set wks = Worksheets("sheet1")
wks.DisplayPageBreaks = False
With wks
'row 1 has headers!
Set ColA = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
Set ColB = .Range("b2", .Cells(.Rows.Count, "B").End(xlUp))

With ColA
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

'change the mycols to the number of columns that
'are associated with column B

myCols = 1 ' columns B only
With ColB.Resize(, myCols)
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

iRow = 2
Do
If Application.CountA(.Cells(iRow, "A").Resize(1, 2)) = 0 Then
Exit Do
End If

If .Cells(iRow, "A").Value = .Cells(iRow, "B").Value _
Or Application.CountA(.Cells(iRow, "A").Resize(1, 2)) = 1 Then
'do nothing
Else
If .Cells(iRow, "A").Value .Cells(iRow, "B").Value Then
.Cells(iRow, "A").Insert shift:=xlDown
Else
.Cells(iRow, "B").Resize(1, myCols).Insert shift:=xlDown
End If
End If
iRow = iRow + 1
Loop
End With

Application.ScreenUpdating = True

End Sub



Jeremy wrote:

I am trying to sort two columns so the data in both of them line up. For
example column a will have a, b, c, d, e, f and so on in it. Column B will
have a, c,e, f, but missing some of the letters that are in a. How do I line
up both of these columns so a lines up with a and b lines up with b and so
on. Where there is not a match in both it leave a blank in the second column.

Thank You For Your Help
Jeremy

--

Dave Peterson

Dave
I got it to work. Let me put one more factor into play and I will have it.
I have a matching b. Now how do I make column c move to the same row as
column b.

Thanks
Jeremy

"Dave Peterson" wrote:

I saved this from a previous post.

Option Explicit
Sub testme()

Application.ScreenUpdating = False

Dim wks As Worksheet
Dim ColA As Range
Dim ColB As Range
Dim iRow As Long
Dim myCols As Long

Set wks = Worksheets("sheet1")
wks.DisplayPageBreaks = False
With wks
'row 1 has headers!
Set ColA = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
Set ColB = .Range("b2", .Cells(.Rows.Count, "B").End(xlUp))

With ColA
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

'change the mycols to the number of columns that
'are associated with column B

myCols = 1 ' columns B only
With ColB.Resize(, myCols)
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

iRow = 2
Do
If Application.CountA(.Cells(iRow, "A").Resize(1, 2)) = 0 Then
Exit Do
End If

If .Cells(iRow, "A").Value = .Cells(iRow, "B").Value _
Or Application.CountA(.Cells(iRow, "A").Resize(1, 2)) = 1 Then
'do nothing
Else
If .Cells(iRow, "A").Value .Cells(iRow, "B").Value Then
.Cells(iRow, "A").Insert shift:=xlDown
Else
.Cells(iRow, "B").Resize(1, myCols).Insert shift:=xlDown
End If
End If
iRow = iRow + 1
Loop
End With

Application.ScreenUpdating = True

End Sub



Jeremy wrote:

I am trying to sort two columns so the data in both of them line up. For
example column a will have a, b, c, d, e, f and so on in it. Column B will
have a, c,e, f, but missing some of the letters that are in a. How do I line
up both of these columns so a lines up with a and b lines up with b and so
on. Where there is not a match in both it leave a blank in the second column.

Thank You For Your Help
Jeremy

--

Dave Peterson

I was going to modify this routine to make it more specific. But I didn't!

All you have to do is change this line:

myCols = 1 ' columns B only
to
myCols = 2 ' columns B:C



Jeremy wrote:

Dave
I got it to work. Let me put one more factor into play and I will have it.
I have a matching b. Now how do I make column c move to the same row as
column b.

Thanks
Jeremy

"Dave Peterson" wrote:

I saved this from a previous post.

Option Explicit
Sub testme()

Application.ScreenUpdating = False

Dim wks As Worksheet
Dim ColA As Range
Dim ColB As Range
Dim iRow As Long
Dim myCols As Long

Set wks = Worksheets("sheet1")
wks.DisplayPageBreaks = False
With wks
'row 1 has headers!
Set ColA = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
Set ColB = .Range("b2", .Cells(.Rows.Count, "B").End(xlUp))

With ColA
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

'change the mycols to the number of columns that
'are associated with column B

myCols = 1 ' columns B only
With ColB.Resize(, myCols)
.Sort key1:=.Cells(1), order1:=xlAscending, header:=xlNo
End With

iRow = 2
Do
If Application.CountA(.Cells(iRow, "A").Resize(1, 2)) = 0 Then
Exit Do
End If

If .Cells(iRow, "A").Value = .Cells(iRow, "B").Value _
Or Application.CountA(.Cells(iRow, "A").Resize(1, 2)) = 1 Then
'do nothing
Else
If .Cells(iRow, "A").Value .Cells(iRow, "B").Value Then
.Cells(iRow, "A").Insert shift:=xlDown
Else
.Cells(iRow, "B").Resize(1, myCols).Insert shift:=xlDown
End If
End If
iRow = iRow + 1
Loop
End With

Application.ScreenUpdating = True

End Sub



Jeremy wrote:

I am trying to sort two columns so the data in both of them line up. For
example column a will have a, b, c, d, e, f and so on in it. Column B will
have a, c,e, f, but missing some of the letters that are in a. How do I line
up both of these columns so a lines up with a and b lines up with b and so
on. Where there is not a match in both it leave a blank in the second column.

Thank You For Your Help
Jeremy

--

Dave Peterson


--

Dave Peterson