How do I make a report listing Names and corresponding program
Then try the version below, which acts on column A... As far as choosing
between Jeanne Doe
and
Doe JEANNE
whichever is found first will be used.
HTH,
Bernie
MS Excel MVP
Sub MakeSummarySheetV3()
Dim mySht As Worksheet
Dim mySumSheet As Worksheet
Dim myCell As Range
Dim myDest As Range
Dim myRow As Long
On Error Resume Next
Application.DisplayAlerts = False
Worksheets("Summary").Delete
Application.DisplayAlerts = True
ActiveSheet.Copy Befo=Sheets(1)
Set mySumSheet = ActiveSheet
mySumSheet.Name = "Summary"
For Each mySht In ActiveWorkbook.Worksheets
If mySht.Name = "Summary" Then GoTo SkipMe:
Set myDest = mySumSheet.Cells(1, 256).End(xlToLeft)(1, 2)
myDest.Value = mySht.Name
Set myDest = myDest.EntireColumn
For Each myCell In mySht.Range("A1").CurrentRegion.Columns(1).Cells
If myCell.Row < 1 Then
If Not IsError(Application.Match(myCell.Value, _
mySumSheet.Range("A:A"), False)) Then
myDest.Cells(Application.Match(myCell.Value, _
mySumSheet.Range("A:A"), False)).Value = "X"
Else
myRow = mySumSheet.Cells(Rows.Count, 1).End(xlUp)(2).Row
mySumSheet.Cells(myRow, 1).Value = myCell.Value
mySumSheet.Cells(myRow, 2).Value = myCell.Offset(0, 1).Value
mySumSheet.Cells(myRow, 3).Value = myCell.Offset(0, 2).Value
myDest.Cells(myRow).Value = "X"
End If
End If
Next myCell
SkipMe:
Next mySht
End Sub
"NeedExcelHelp07" wrote in
message ...
What I'm getting:
PRIMARY SECONDARY ID NAME Software A Software B Software C
Software d....
BZ0T23 Jeanne Doe X
BZ0T23 Doe JEANNE X
X
BZ0T23 Doe JEANNE
X
Ok the above is what I'm getting after running the Macro.
So I'm asking how to merge them to make it look like below:
PRIMARY SECONDARY ID NAME Software A Software B Software C
Software d....
BZ0T23 Jeanne Doe X X
X X
Other than this, the Macro works well.
Thanks alot for the help.
|