Sorry, I made a last minute change to the approach I used in my code and
forgot to properly account for it. Give this code a try instead...

Sub CollapseData()
Dim X As Long, LastRow As Long, Index As Long
Dim R As Variant, V() As Variant, SerNum As String
Index = 1
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
ReDim V(1 To LastRow + 1, 1 To 3)
R = Range("A2:C" & LastRow + 1)
For X = 1 To LastRow - 1
SerNum = SerNum & " " & Left("0", -(R(X, 2) Like "7####")) & R(X, 2)
If R(X, 1) < R(X + 1, 1) Or R(X, 3) < R(X + 1, 3) Then
V(Index, 1) = R(X, 1)
V(Index, 2) = SerNum
V(Index, 3) = R(X, 3)
SerNum = ""
Index = Index + 1
End If
Next
Range("A2:C" & (LastRow + 1)).NumberFormat = "@"
Range("A2:C" & (LastRow + 1)) = V
End Sub

--
Rick (MVP - Excel)


"Dee Sperling" wrote in message
...
Rick,

Thank you.

I ran the code against another set of data and it only added the leading 0
to the SerialNums that had more than 1 entry for that RecNum.

Here's the data I used for testing:
Record Number SerialNum Last Name
4883 71111 Orange
4983 1288888 Purple
5019 72222 Green
5078 73333 Red
5078 72314 Red
5078 79586 Red
5078 70005 Red
5078 72020 Red
5078 73030 Red
5078 76565 Red
5078 78585 Red
5078 79955 Red
5078 333333 Red
5078 77777 Blue
5078 79494 Blue
5078 78484 Blue
5078 77777 Blue
5078 78888 Blue
5078 72222 Blue
5078 75555 Blue
5078 70099 Blue
5078 78080 Blue
5078 312321 Blue

Dee

"Rick Rothstein" wrote:

I believe this code does what you want...

Sub CollapseData()
Dim X As Long, LastRow As Long, Index As Long
Dim R As Variant, V() As Variant, SerNum As String
Index = 1
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
ReDim V(1 To LastRow + 1, 1 To 3)
R = Range("A2:C" & LastRow + 1)
For X = 1 To LastRow - 1
SerNum = SerNum & " " & Left("0", -(R(X, 2) Like "7####")) & R(X, 2)
If R(X, 1) < R(X + 1, 1) Or R(X, 3) < R(X + 1, 3) Then
V(Index, 1) = R(X, 1)
V(Index, 2) = SerNum
V(Index, 3) = R(X, 3)
SerNum = ""
Index = Index + 1
End If
Next
Range("A2:C" & (LastRow + 1)) = V
End Sub

--
Rick (MVP - Excel)