Combining multiple records into single string (Office 2003)

Topic

New Reply

Hello All,

I have this spreadsheet (see attached). Is there a way (by macro) to “group” the data according to MemberNo, given the fixed range? For example, Member 155 has three records and Member 153 has one record. After running the macro, the (new) sheet should contain: 155Fund11.161.35

Fund21.201.39

Fund30.670.63, at Row 1; and 153Fund10.740.76, at Row 2. I have 20000 rows to do and really need to automate it.

Thank you in advance.

Reply | Quote

Replies

Try this:

Sub Reshape()
Dim lngRow1 As Long
Dim lngRow2 As Long
Dim lngCol2 As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Set ws1 = Worksheets(“Sheet1”)
Set ws2 = Worksheets(“Sheet2”)
For lngRow1 = 2 To ws1.Range(“A65536”).End(xlUp).Row
If Not (ws1.Range(“A” & lngRow1) = ws1.Range(“A” & (lngRow1 – 1))) Then
lngRow2 = lngRow2 + 1
lngCol2 = 1
ws2.Cells(lngRow2, 1) = ws1.Range(“A” & lngRow1)
End If
lngCol2 = lngCol2 + 1
ws2.Cells(lngRow2, lngCol2) = ws1.Range(“B” & lngRow1)
lngCol2 = lngCol2 + 1
ws2.Cells(lngRow2, lngCol2) = ws1.Range(“C” & lngRow1)
lngCol2 = lngCol2 + 1
ws2.Cells(lngRow2, lngCol2) = ws1.Range(“D” & lngRow1)
Next lngRow1
End Sub

Reply | Quote

Thanks again Hans,

I probably did not make myself clear. Is it possible to make the combined data to be in Column A only with delimiters “” to represent the original Column and ”

” to represent original Row? I need to pull the data into Word and do mass find and replace.

Thanks.

Reply | Quote

Can you live with this? (It’s not exactly what you asked)

Sub Reshape()
Dim lngRow1 As Long
Dim lngRow2 As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim strVal As String
Set ws1 = Worksheets(“Sheet1”)
Set ws2 = Worksheets(“Sheet2”)
For lngRow1 = 2 To ws1.Range(“A65536”).End(xlUp).Row
If Not (ws1.Range(“A” & lngRow1) = ws1.Range(“A” & (lngRow1 – 1))) Then
lngRow2 = lngRow2 + 1
strVal = ws1.Range(“A” & lngRow1)
End If
strVal = strVal & ”

” & ws1.Range(“B” & lngRow1)
strVal = strVal & “” & ws1.Range(“C” & lngRow1)
strVal = strVal & “” & ws1.Range(“D” & lngRow1)
ws2.Cells(lngRow2, 1) = strVal
Next lngRow1
End Sub

Reply | Quote

More than good for me. I just need to replace the first occurance of ”

” after MemberNo.

Thank you once again.

Reply | Quote

Here is a version that will use after MemberNo:

Sub Reshape()
Dim lngRow1 As Long
Dim lngRow2 As Long
Dim ws1 As Worksheet
Dim ws2 As Worksheet
Dim strVal As String
Application.ScreenUpdating = False
Set ws1 = Worksheets(“Sheet1”)
Set ws2 = Worksheets(“Sheet2”)
For lngRow1 = 2 To ws1.Range(“A65536”).End(xlUp).Row
If Not (ws1.Range(“A” & lngRow1) = ws1.Range(“A” & (lngRow1 – 1))) Then
lngRow2 = lngRow2 + 1
strVal = ws1.Range(“A” & lngRow1) & “” & ws1.Range(“B” & lngRow1)
Else
strVal = strVal & ”

” & ws1.Range(“B” & lngRow1)
End If
strVal = strVal & “” & ws1.Range(“C” & lngRow1)
strVal = strVal & “” & ws1.Range(“D” & lngRow1)
ws2.Cells(lngRow2, 1) = strVal
Next lngRow1
Application.ScreenUpdating = True
End Sub

Reply | Quote