Results 1 to 2 of 2
  1. #1
    Join Date
    May 2005
    Posts
    125
    Provided Answers: 1

    Question Answered: VBA to Transpose Multiple Data Sets

    Hello

    In the attached file the data held within the "TestData" Tab contains a system extract of contact details. (2 records)

    1. Each block of data has exactly the same number of fields and headers in column A, column B contains the actual data required associated to the fields.
    2. Each block of data is separated by one line

    What I would like to be able to do is loop through the "TestData" tab and transpose each block of data into the "DesiredOutput" tab as shown in my attached example, so I get a nice data set for mail merging etc..

    Can any one help or advise me of the best possible solution

    Thanks
    Attached Files Attached Files

  2. Best Answer
    Posted by MarkWhyte

    "Figured it out, its a bit rough and ready but does the job

    Code:
    Sub TransposeData()
       
       Sheets("Data").Select
       
        Row = 0
        col = 4
    
        'Find the last cell populated
        Max = Range("A650000").End(xlUp).Row 'Or whatever the last allowed row number is
    
        'loop through the data
        For i = 1 To Max
            'Look for new row indicator in this example "Date" and start a new row if they are
            If (Left(Range("A" & i).Value, 4) = "Date") Then
                 Row = Row + 1
                 col = 4
            End If
    
            Cells(Row, col).Value = Range("B" & i).Value
            If (i > Row) Then
                Range("B" & i).Value = ""
            End If
            col = col + 1
    
        Next i
    End Sub
    "


  3. #2
    Join Date
    May 2005
    Posts
    125
    Provided Answers: 1
    Figured it out, its a bit rough and ready but does the job

    Code:
    Sub TransposeData()
       
       Sheets("Data").Select
       
        Row = 0
        col = 4
    
        'Find the last cell populated
        Max = Range("A650000").End(xlUp).Row 'Or whatever the last allowed row number is
    
        'loop through the data
        For i = 1 To Max
            'Look for new row indicator in this example "Date" and start a new row if they are
            If (Left(Range("A" & i).Value, 4) = "Date") Then
                 Row = Row + 1
                 col = 4
            End If
    
            Cells(Row, col).Value = Range("B" & i).Value
            If (i > Row) Then
                Range("B" & i).Value = ""
            End If
            col = col + 1
    
        Next i
    End Sub
    Last edited by MarkWhyte; 11-09-15 at 07:15.

Posting Permissions

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