Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 184
Default Compare & align 2 cols of Employee Names in sorted alpha order withVBA

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.
  #2   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 11,501
Default Compare & align 2 cols of Employee Names in sorted alpha order wit

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
"u473" wrote:

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.

  #3   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 11,501
Default Compare & align 2 cols of Employee Names in sorted alpha order

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

"Mike H" wrote:

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
"u473" wrote:

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.

  #4   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 184
Default Compare & align 2 cols of Employee Names in sorted alpha orderwit

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.
  #5   Report Post  
Posted to microsoft.public.excel.misc
external usenet poster
 
Posts: 184
Default Compare & align 2 cols of Employee Names in sorted alpha order

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.
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules

Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On


Similar Threads
Thread Thread Starter Forum Replies Last Post
Compare 2 columns and align duplicates into same row AGOLFA Excel Worksheet Functions 8 November 9th 09 07:48 PM
Align & Compare row with column [email protected] New Users to Excel 2 March 8th 07 11:41 AM
wnat to extract first & last names in sep cols from name list in 1 CHES Excel Worksheet Functions 4 March 8th 07 03:27 AM
series order - sorted? pp Charts and Charting in Excel 1 October 10th 06 12:45 AM
Macro to align and compare multiple rows and columns Manav Ram via OfficeKB.com New Users to Excel 1 March 5th 05 12:38 AM


All times are GMT +1. The time now is 01:49 AM.

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Copyright ©2004-2024 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"