Hi all, having a problem trying to merge rows in a client database due to duplications. What I need to do is merge all values into one row. Format is as such Jack Jones 22/1/9 $120 - - Jack Jones 22/1/9 - $240 - Jack Jones 22/1/9 - - $320 what I'm trying to do Jack Jones 22/1/9 $120 $240 $320 There are 700 rows x 32 columns. Only 390 of these rows are unique though - which is what i need to merge it down to. I found a few scripts already but it's removing some members and leaving me with 260 rows, unfortunately my VB is too rusty to edit it though. Any help would be great, Scott

Oh, and it might help to know that Col 1 contains the unique identifier - "Member Number".

What version of Excel do you have? If you have 2003, there is a "Merge Cells Wizard" add in available. Or, you could use the "Concatenate" function. Soylent Green is PEOPLE!!!

Excel 2000, yeah.. forgot to mention that yeah.

Current VB script I'm running on it - amalgamation of 2 I found on the net. Option Explicit Dim firstR, curR, lastR, testR Dim C, r Dim Col Dim srcsheet As Worksheet Dim whattodelete As Range Sub consolidater() Set whattodelete = Rows(1) firstR = 1 For lastR = 1 To ActiveSheet.UsedRange.Rows.Count If Cells(lastR + 1, 1) <> Cells(firstR + 1, 1) Then Call mergit(firstR, lastR) firstR = lastR + 1 End If Next lastR whattodelete.Delete End Sub Sub mergit(firstR, lastR) Debug.Print "first/last", firstR, lastR For curR = firstR To lastR ' curR, col should be replaced with first non blank For Col = 2 To 42 If Cells(curR, Col) = "" Then ' current cell is blank, For testR = firstR To lastR ' look at all other values in column If Cells(testR, Col) <> "" Then ' and take the first one not blank Cells(curR, Col) = Cells(testR, Col) End If Next testR End If Next Col Set whattodelete = Union(whattodelete, Rows(firstR)) Next curR End Sub Public Sub DeleteDuplicateRows() ' ' This macro deletes duplicate rows in the selection. Duplicates are ' counted in the COLUMN of the active cell. Dim Col As Integer Dim r As Long Dim C As Range Dim N As Long Dim V As Variant Dim Rng As Range On Error GoTo EndMacro Application.ScreenUpdating = False Application.Calculation = xlCalculationManual Col = ActiveCell.Column If Selection.Rows.Count > 1 Then Set Rng = Selection Else Set Rng = ActiveSheet.UsedRange.Rows End If N = 0 For r = Rng.Rows.Count To 1 Step -1 V = Rng.Cells(r, 1).Value If Application.WorksheetFunction.CountIf(Rng.Columns(1), V) > 1 Then Rng.Rows(r).EntireRow.Delete N = N + 1 End If Next r EndMacro: Application.ScreenUpdating = True Application.Calculation = xlCalculationAutomatic End Sub