Consulting

Results 1 to 6 of 6

Thread: Transpose Data Blocks To the Right

  1. #1
    VBAX Regular
    Joined
    Jan 2016
    Posts
    55
    Location

    Transpose Data Blocks To the Right

    Good morning,

    I need a macro that should transpose data in the columns to the right in the same worksheet. As you can see from the attached workbook, in the column A are item numbers that have corresponding data in column B and C. What I need is to transpose this data based on item number. For example, Item 100 repeats 7 times and Store Number and Date Sent should be filled through 7 columns to the right Store1, Date1 through Store 7, Date7. Now, next block repeats 13 times and its corresponding data should transpose to the right filling the maximum number of columns. Data should start transposing from the first row where new data block starts. I am ok with deleting empty rows after transposing.
    Thank you in advance.
    Attached Files Attached Files

  2. #2
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    382
    Location
    Hi barim!
    Not sure, but I think that's what you want(or nearly so).
    Sub Test()
    Dim i&, c&
    With Sheets(1)
      For i = 2 To .Cells(Rows.Count, 1).End(3).Row
        If .Cells(i, 1) <> .Cells(i - 1, 1) Then
          c = 4
        Else
          c = c + 2
        End If
        .Cells(i, c).Resize(, 2) = .Cells(i, 2).Resize(, 2).Value
      Next i
    End With
    End Sub
    Last edited by 大灰狼1976; 04-16-2019 at 12:03 AM.

  3. #3
    VBAX Regular
    Joined
    Jan 2016
    Posts
    55
    Location
    This works almost perfectly. Thanks so much for this. I noticed it drops down row by row and it looks like a cascade. Is there a way to put everything on 1 line per block? For example, Store 501 through 506 to line up from D2 to Q2, and to do so forth for the next block D9 through AC9. Thanks again.

  4. #4
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    382
    Location
    something like below:
    Sub Test()
    Dim i&, c&, r&
    With Sheets(1)
      For i = 2 To .Cells(Rows.Count, 1).End(3).Row
        If .Cells(i, 1) <> .Cells(i - 1, 1) Then
          c = 4
          r = i
        Else
          c = c + 2
        End If
        .Cells(r, c).Resize(, 2) = .Cells(i, 2).Resize(, 2).Value
      Next i
    End With
    End Sub

  5. #5
    VBAX Regular
    Joined
    Jan 2016
    Posts
    55
    Location
    It works like a Swiss watch. Thank you so much, you are genius.

  6. #6
    VBAX Mentor 大灰狼1976's Avatar
    Joined
    Dec 2018
    Location
    SuZhou China
    Posts
    382
    Location
    You're welcome

Posting Permissions

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