#1
|
|||
|
|||
Excel 2007-How to merge multiple records into one
I needed help with merging multiple records into one.
In the attached spreadsheet I have the same user having access to multiple applications. What I need to do is compare the last, first names and the department and if they all match (b'coz there are some users with the exact last & first names, but in different depts) then merge the records into one and mark "Y" for all the applications the person has access to. Also, in my worksheet I have last names in all caps, or sentence case etc. I tried converting it to proper case (sentence case-e.g.Martin). But I get an Invalid ref. error. Why? I would greatly appreciate a quick response! Many thanks in advance! |
#2
|
||||
|
||||
Try the following macro:
Code:
Sub MergeRows() Application.ScreenUpdating = False Dim LRow As Long, LCol As Long, strAddr As String Dim I As Long, J As Long, bMatch As Boolean On Error GoTo Abort With ActiveSheet With .Cells.SpecialCells(xlCellTypeLastCell) strAddr = .Address LRow = .Row LCol = .Column End With 'Sort the records by employee within department With .Sort .SortFields.Clear .SortFields.Add Key:=Range("C2:C" & LRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("A2:A" & LRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("B2:B" & LRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A1:" & strAddr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With 'Convert all employee names to proper case For I = 2 To LRow For J = 1 To 2 .Cells(I, J).Value = WorksheetFunction.Proper(.Cells(I, J).Value) Next Next I 'Merge employee records For I = LRow To 3 Step -1 bMatch = True Application.StatusBar = "Processing " & .Cells(I, 3).Value For J = 1 To 3 If .Cells(I, J).Value <> .Cells(I - 1, J).Value Then bMatch = False Exit For End If Next J If bMatch = True Then For J = 4 To LCol If Trim(.Cells(I, J).Value) <> "" Then .Cells(I - 1, J).Value = .Cells(I, J).Value End If Next J .Rows(I).EntireRow.Delete End If Next I 'Re-sort records by employee With .Sort .SortFields.Clear .SortFields.Add Key:=Range("A2:A" & LRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("B2:B" & LRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SortFields.Add Key:=Range("C2:C" & LRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal .SetRange Range("A1:" & strAddr) .Header = xlYes .MatchCase = False .Orientation = xlTopToBottom .SortMethod = xlPinYin .Apply End With End With Application.StatusBar = "Done!!" GoTo Terminate Abort: MsgBox "Processing Error On Line " & I + 1, vbCritical Terminate: Application.ScreenUpdating = True End Sub
__________________
Cheers, Paul Edstein [Fmr MS MVP - Word] |
|
Similar Threads | ||||
Thread | Thread Starter | Forum | Replies | Last Post |
Multiple mail merge records on the same page | allenglishboy | Mail Merge | 3 | 07-18-2012 06:22 AM |
Access to Word, Creating a list from multiple records | daymaker | Mail Merge | 9 | 03-14-2012 06:37 AM |
How can I retreive multiple records using a lookup? | jrpey | Excel | 3 | 11-14-2011 02:10 PM |
Merge Doc skips records | eonelson | Excel | 11 | 01-30-2011 03:49 PM |
Help with consolidating multiple records into one | wbiggs2 | Excel | 0 | 11-30-2006 01:02 PM |