Results 1 to 6 of 6
  1. #1
    Star Lounger
    Join Date
    Feb 2005
    Posts
    61
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Combining multiple records into single string (Office 2003)

    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: 155<>Fund1<>1.16<>1.35

    Fund2<>1.20<>1.39

    Fund3<>0.67<>0.63, at Row 1; and 153<>Fund1<>0.74<>0.76, at Row 2. I have 20000 rows to do and really need to automate it.

    Thank you in advance.

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Combining multiple records into single string (Office 2003)

    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

  3. #3
    Star Lounger
    Join Date
    Feb 2005
    Posts
    61
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Combining multiple records into single string (Office 2003)

    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.

  4. #4
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Combining multiple records into single string (Office 2003)

    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

  5. #5
    Star Lounger
    Join Date
    Feb 2005
    Posts
    61
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Combining multiple records into single string (Office 2003)

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

    " after MemberNo.

    Thank you once again.

  6. #6
    Plutonium Lounger
    Join Date
    Mar 2002
    Posts
    84,353
    Thanks
    0
    Thanked 29 Times in 29 Posts

    Re: Combining multiple records into single string (Office 2003)

    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

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •