Microsoft Office Forums

Go Back   Microsoft Office Forums > >

Reply
 
Thread Tools Display Modes
  #1  
Old 10-29-2012, 01:30 AM
mag mag is offline Excel 2007-How to merge multiple records into one Windows 7 64bit Excel 2007-How to merge multiple records into one Office 2010 64bit
Novice
Excel 2007-How to merge multiple records into one
 
Join Date: Oct 2012
Posts: 11
mag is on a distinguished road
Exclamation 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!
Attached Files
File Type: xlsx TEST FOR MERGING ROWS.xlsx (98.1 KB, 17 views)
Reply With Quote
  #2  
Old 11-21-2012, 12:11 AM
macropod's Avatar
macropod macropod is offline Excel 2007-How to merge multiple records into one Windows 7 64bit Excel 2007-How to merge multiple records into one Office 2010 32bit
Administrator
 
Join Date: Dec 2010
Location: Canberra, Australia
Posts: 21,232
macropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant futuremacropod has a brilliant future
Default

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]
Reply With Quote
Reply

Thread Tools
Display Modes


Similar Threads
Thread Thread Starter Forum Replies Last Post
Excel 2007-How to merge multiple records into one Access to Word, Creating a list from multiple records daymaker Mail Merge 10 07-25-2021 03:11 AM
Excel 2007-How to merge multiple records into one Multiple mail merge records on the same page allenglishboy Mail Merge 3 07-18-2012 06:22 AM
Excel 2007-How to merge multiple records into one How can I retreive multiple records using a lookup? jrpey Excel 3 11-14-2011 02:10 PM
Excel 2007-How to merge multiple records into one 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

Other Forums: Access Forums

All times are GMT -7. The time now is 10:48 AM.


Powered by vBulletin® Version 3.8.11
Copyright ©2000 - 2021, vBulletin Solutions Inc.
Search Engine Optimisation provided by DragonByte SEO (Lite) - vBulletin Mods & Addons Copyright © 2021 DragonByte Technologies Ltd.
MSOfficeForums.com is not affiliated with Microsoft