Compare & align 2 cols of Employee Names in sorted alpha order withVBA

U

u473

The following solution came from an earlier post. I would like to
implement it with VBA,
and print the list of Newcomers and Missing
..
How to space out mismatches of 2 similar columns while keeping like
cells aligned ?
For example, how do I convert a worksheet containing (in columns A and
B):
..
A  A
B  B
C  D
D  E
F  G
....

... to ..

A A
B B
C
D D
    E
F
    G
..
Newcomers :
E
G
Missing :
C
F
..
Steps
1. Copy n paste source data in cols A and B into col C,
one paste below the other (order immaterial).
Enter a col label in C1, eg: All
..
2. Select col C, click Data > Filter > Advanced Filter
List range: $C:$C
Check "Copy to another location"
Copy to: $D$1
Check "Unique records only"
Click OK
This extracts a uniques list into col D
..
3. Select col D,
do a Data > Sort* > Sort by "All" > Ascending > OK
*continue with current selection
..
4. Then just place in
E2: =IF(ISNUMBER(MATCH(D2,A:A,0)),D2,"")
F2: =IF(ISNUMBER(MATCH(D2,B:B,0)),D2,"")
Select E2:F2, copy down to the last row of data in col D
..
5. Print Newcomers & Missing

Thank you for your help
J.P.
 
M

Mike H

hi,

I may have made this far too complicated and look for someone to simplify
but in the meantine right click your sheet tab, view code and paste this in
and run it

Sub LineEmUp()
Dim flag As Boolean
Dim MyRangeA As Range, MyRangeC As Range
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For x = lastrow To 2 Step -1
If IsEmpty(Cells(x - 1, 1)) Or IsEmpty(Cells(x, 1)) Then GoTo getmeout
If Asc(UCase(Cells(x, 1))) - Asc(UCase(Cells(x - 1, 1))) > 1 Then
For p = 1 To (Asc(Cells(x, 1)) - Asc(Cells(x - 1, 1))) - 1
Rows(x).Select
Selection.Insert Shift:=xlDown
Next
getmeout:
End If
Next
'sort B
Columns("B:B").Insert Shift:=xlToRight
lastrowC = Cells(Rows.Count, "C").End(xlUp).Row
Lastrowa = Cells(Rows.Count, "A").End(xlUp).Row
Set MyRangeC = Range("C1:C" & lastrowC)
Set MyRangeA = Range("A1:A" & Lastrowa)
For Each c In MyRangeC
For Each a In MyRangeA
flag = True
If UCase(a.Value) = UCase(c.Value) Then
a.Offset(, 1).Value = c.Value
flag = False
Exit For
End If
Next
If flag = True Then
templast = Cells(Rows.Count, "A").End(xlUp).Row
Range("A" & templast + 1).Value = c.Value
Range("A" & templast + 1).Offset(, 1).Value = c.Value
flag = False
End If
Next
Columns("C:C").Delete Shift:=xlToLeft
End Sub


Mike
 
M

Mike H

A few bugs taken out

Sub LineEmUp()
Dim flag As Boolean
Dim MyRangeA As Range, MyRangeC As Range
Columns("A:A").Sort Key1:=Range("A1"), Order1:=xlAscending
lastrow = Cells(Rows.Count, "A").End(xlUp).Row
For x = lastrow To 2 Step -1
If IsEmpty(Cells(x - 1, 1)) Or IsEmpty(Cells(x, 1)) Then GoTo getmeout
If Asc(UCase(Cells(x, 1))) - Asc(UCase(Cells(x - 1, 1))) > 1 Then
For p = 1 To (Asc(Cells(x, 1)) - Asc(Cells(x - 1, 1))) - 1
Rows(x).Select
Selection.Insert shift:=xlDown
Next
getmeout:
End If
Next
'sort B
Columns("B:B").Insert shift:=xlToRight
lastrowC = Cells(Rows.Count, "C").End(xlUp).Row
lastrowA = Cells(Rows.Count, "A").End(xlUp).Row
Set MyRangeC = Range("C1:C" & lastrowC)
Set MyRangeA = Range("A1:A" & lastrowA)
For Each c In MyRangeC
For Each a In MyRangeA
flag = True
If UCase(a.Value) = UCase(c.Value) Then
a.Offset(, 1).Value = c.Value
flag = False
Exit For
End If
Next
If flag = True Then
templast = Cells(Rows.Count, "B").End(xlUp).Row
Range("A" & templast + 1).Offset(, 1).Value = c.Value
flag = False
End If
Next
'Tidy Up
Columns("C:C").Delete shift:=xlToLeft
Columns("A:B").Sort Key1:=Range("A1"), Order1:=xlAscending
lastrowA = Cells(Rows.Count, "A").End(xlUp).Row
lastrowB = Cells(Rows.Count, "B").End(xlUp).Row
For x = WorksheetFunction.Max(lastrowA, lastrowB) To 1 Step -1
If IsEmpty(Cells(x, 1)) And IsEmpty(Cells(x, 2)) Then
Rows(x).EntireRow.Delete
End If
Next
End Sub


Mike
 
U

u473

Woooww ! I am impressed and thank you for your help. I am going to
digest on your code line by line.
I should not have any problem adapting your code for Projects list in
Columns rather than Rows.
However syntaxwise, how would I modify the code for each range in
separate workbook, same folder ?
I need to grasp that syntax.
Thank you again,
J.P.
 
U

u473

There is still a bug I cannot trace so far.
Before execution:
AA
BB
CD
DE
FG
After execution :
AA
BB
C
DD
F "E" is missing
G

Thank you for your help again,

J.P.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top