Excel 2007-How to merge multiple records into one

mag · #1 10-29-2012, 01:30 AM

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!

macropod · #2 11-21-2012, 12:11 AM

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

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