CODEWITHSUNDEEP
excelvba
nick lanta
nick lanta

Reputation: 638

Transpose data in a Step 2 type fashion?

I have this code that creates an overarching array based on a data set range Data.

I want to have it transpose the row blocks (always every two rows Step -2) and place that next block just as an offset(1) from what was last transposed.

For example: Rows 2-3 would be in E1:D134, rows 4-5 would be in E135:D169, and so forth.

What this code used to do is print the individual arrays to a worksheets and save it off, but I'm truncating it a little to have it print the first two transposed rows (to just two columns) starting in E1, and then then the next two rows underneath would be offset to the next available spot underneath in columns E:D.

Option Explicit
Sub Main()
  Dim wb As Workbook
  Dim Data, Last, Mgr
  Dim i As Long, j As Long, k As Long, a As Long
  Dim Dest As Range
  Set wb = ThisWorkbook
  Set Dest = wb.Sheets("Sheet2").Range("E1")
  With ThisWorkbook.Sheets("Sheet3")
    Data = .Range("ed2", .Range("A" & Rows.Count).End(xlUp))
  End With
  wb.Activate
  Application.ScreenUpdating = False
  For i = 1 To UBound(Data)
    If Data(i, 1) <> Last Then
      If i > 1 Then
        Dest.Select
    End If
      Last = Data(i, 1)
      j = 0
    End If
    a = 0
    For k = 1 To UBound(Data, 2)
      Dest.Offset(a, j) = Data(i, k)
      a = a + 1
    Next
    j = j + 1
  Next
End Sub

How would I designate that based on the above code?

Upvotes: 0

Views: 31

Answers (1)

Ahmed AU
Ahmed AU

Reputation: 2777

There are multiple ways to achieve this. This may me closest to your approach ( if I understood correctly what you want to achieve), May try

Sub Main()
  Dim wb As Workbook
  Dim Data, Last, Mgr
  Dim Rw As Long, Col As Long
  Dim i As Long, k As Long, j As Long
  Dim Dest As Range, TmpArr As Variant
  Set wb = ThisWorkbook
  Set Dest = wb.Sheets("Sheet2").Range("E1")
  With ThisWorkbook.Sheets("Sheet3")
    Data = .Range("ed2", .Range("A" & Rows.Count).End(xlUp))
  End With


Rw = -1
For i = LBound(Data, 1) To UBound(Data, 1) Step 2
k = 1
If i = UBound(Data) Then k = 0
    For Col = LBound(Data, 2) To UBound(Data, 2)
    Rw = Rw + 1
        For j = 0 To k
        Dest.Offset(Rw, j).Value = Data(i + j, Col)
        Next j
    Next Col
Next i

End Sub

Upvotes: 0

Related Questions