2

I have a little experience with VBA, and I would really appreciate any help with this issue. In a basic sense, I need to convert 2 columns of data in sheet 1 to rows of data in sheet 2.

It currently looks like this in Excel:

enter image description here

And I need it to look like this:

enter image description here

I've already written the code to transfer the headings over to sheet 2, and it works fine. I'm just having issues with transferring the actual values in the correct format. Right now, the body of my code is 

ws.Range("B3").Copy
ws2.Range("C2").PasteSpecial xlPasteValues

ws.Range("B4").Copy
ws2.Range("D2").PasteSpecial xlPasteValues

ws.Range("B5").Copy
ws2.Range("E2").PasteSpecial xlPasteValues

ws.Range("B6").Copy
ws2.Range("F2").PasteSpecial xlPasteValues

continued on and on. However, this really won't work, as the actual document I'm working on has tens of thousands of data points. I know there's a way to automate this process, but everything I've tried has either done nothing or given an error 1004.

Any help with this would be greatly appreciated!!

Edit: There are hundreds of little sections of data, each 18 rows long (1 row for the frame #, 1 row for the time, and 1 row for each of the 16 channels). I'm trying to get it into a loop with a step size of 18. Is that possible? I'm fine with loops, but I've never done a loop with copying and pasting cell values

nicolaus-hee
  • 787
  • 1
  • 9
  • 25
Rawr
  • 45
  • 1
  • 2
  • 5

6 Answers6

1

Try this code:

Dim X() As Variant
Dim Y() As Variant
X = ActiveSheet.Range("YourRange").Value
Y = Application.WorksheetFunction.Transpose(X)

Also check out this link: Transpose a range in VBA

Community
  • 1
  • 1
Eldar Agalarov
  • 4,849
  • 4
  • 30
  • 38
0

Use Copy, then Paste Special+Transpose to turn your columns into rows:
Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True

iDevlop
  • 24,841
  • 11
  • 90
  • 149
  • Can that be made into a loop? I tried something like Set wb = Application.ActiveWorkbook Set ws = wb.Worksheets("Sheet1") Set ws2 = wb.Worksheets("Sheet2") x = 2 r = 3 For r = 3 To r = 1000 Step 17 ws.Range("B" & r).Copy ws2.Range("C" & x).PasteSpecial PasteValues, Transpose:=True x = x + 1 r = r + 1 Next and it didn't work. Can transpose pasting not be put into a loop format? – Rawr Jul 11 '13 at 15:00
0

Try this:

Sub TansposeRange()
 Dim InRange As Range
 Dim OutRange As Range
 Dim i As Long

 Set InRange = Sheet1.Range("B3:B10002")
 Set OutRange = Sheet2.Range("C2")

 InRange.Worksheet.Activate
 InRange.Select
 Selection.Copy

 OutRange.Worksheet.Activate
 OutRange.Select

 Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True

End Sub
d-stroyer
  • 2,638
  • 2
  • 19
  • 31
  • Thanks for your quick reply! I tried to run that, and I got a run-time 424 error (object required). Also, is there a way to do that in a loop with a step size? Because not everything from B in sheet 1 goes into C in sheet 2. It would be B3, B21, B39, etc go into C, while B4, B22, B40 go into D, and so on. – Rawr Jul 11 '13 at 14:58
0

This method leverages loops and arrays to transfer the data. It isn't the most dynamic method but it gets the job done. All the loops use existing constants, so if your data set changes you can adjust the constants and it should run just fine. Make sure to adjust the worksheet names to match the names you are using in your excel document. In effect, what this is doing is loading your data into an array and transposing it onto another worksheet.

If your data set sizes change quite a bit, you will want to include some logic to adjust the loop variables and array size declarations. If this is the case, let me know and I'll figure out how to do that and post an edit.

Sub moveTimeData()

Set source = ThisWorkbook.Sheets("RawData")
Set dest = ThisWorkbook.Sheets("TransposeSheet")

Const dataSetSize = 15

Const row15Start = 3
Const row15End = 18
Const row30Start = 21
Const row30End = 36

Const colStart = 2

Const destColStart = 2
Const dest15RowStart = 2
Const dest30RowStart = 3

Dim time15Array() As Integer
Dim time30Array() As Integer
ReDim time15Array(0 To dataSetSize)
ReDim time30Array(0 To dataSetSize)

Dim X As Integer
Dim Y As Integer
Dim c As Integer
c = 0

For X = row15Start To row15End
    time15Array(c) = source.Cells(X, colStart).Value
    c = c + 1
Next X

c = 0
For X = row30Start To row30End
    time30Array(c) = source.Cells(X, colStart).Value
    c = c + 1
Next X

For X = 0 To dataSetSize
    dest.Cells(dest15RowStart, X + destColStart).Value = time15Array(X)
Next X

For X = 0 To dataSetSize
    dest.Cells(dest30RowStart, X + destColStart).Value = time30Array(X)
Next X

End Sub

EDIT-> I think this is what you are looking for after reading your edits

Sub moveTimeData()

Set source = ThisWorkbook.Sheets("RawData")
Set dest = ThisWorkbook.Sheets("TransposeSheet")

Const numberDataGroups = 4
Const dataSetSize = 15
Const stepSize = 18

Const sourceRowStart = 3

Const sourceColStart = 2

Const destColStart = 2
Const destRowStart = 2



Dim X As Integer
Dim Y As Integer
Dim currentRow As Integer
currentRow = destRowStart



For X = 0 To numberDataGroups
    For Y = 0 To dataSetSize
        dest.Cells(currentRow, Y + destColStart).Value = source.Cells((X * stepSize) + (Y    + sourceRowStart), sourceColStart)
    Next Y
    currentRow = currentRow + 1
Next X


End Sub

Now the key to this working is knowing how many groups of data you are dealing with after the data dump. You either need to include logic for detecting that or adjust the constant called numberDataGroups to reflect how many groups you have. Note: I leveraged a similar technique for traversing arrays that have their data stored in Row Major format.

Paul Renton
  • 2,652
  • 6
  • 25
  • 38
  • Thanks!! Is there a way to automate the process even more? There are oodles of sections of data, not just the two I showed in the sample. It goes to row 6000 something. I'm trying something like For r = 3 To 6000 Step 18 ws.Range("B" & r).Resize(18).Copy ws2.Range("C" & (r - 1)) Next r which, of course, isn't working. is something like this even possible in VBA? – Rawr Jul 11 '13 at 16:38
  • Yes that isn't hard to do. Would you mind editing your question to include the full scope of the problem? Do you know many sections of data there will be when you receive the data dump? Will it change? I will update the code once I know all of what you asking. – Paul Renton Jul 11 '13 at 16:39
0

This is a way to do it using a loop, here illustrated with a step of 2

Notice that you have to specify the OutRange precisely the correct size (here NTR2 is the 10001's cell of the 2nd row).

Sub TansposeRange()
 Dim InRange As Range
 Dim OutRange As Range
 Dim i As Long

 Set InRange = Sheet1.Range("B3:B10002")
 Set OutRange = Sheet2.Range("C2:NTR2")

 For i = 1 To 10000 Step 2
  OutRange.Cells(1, i) = InRange.Cells(i, 1)
 Next i

End Sub
d-stroyer
  • 2,638
  • 2
  • 19
  • 31
0
    'The following code is working OK
    Sub TansposeRange()
    '
    ' Transpose Macro
    '
    Dim wSht1 As Worksheet
    Dim rng1 As Range
    Dim straddress As String
    Set wSht1 = ActiveSheet

    On Error Resume Next
    Set rng1 = Application.InputBox(Prompt:="Select Columns or Rows to transpose", _
                                   Title:="TRANSPOSE", Type:=8)
    If rng1 Is Nothing Then
        MsgBox ("User cancelled!")
        Exit Sub
    End If
    straddress = InputBox(Prompt:="Full cell Address as Sheet2!A1", _
          Title:="ENTER Full Address", Default:="Sheet1!A1")
    If straddress = vbNullString Then
         MsgBox ("User cancelled!")
         Exit Sub
    End If      

    Application.ScreenUpdating = False
    rng1.Select
    rng1.Copy

    On Error GoTo 0

    'MsgBox straddress
    Range(straddress).PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
        False, Transpose:=True
    Application.ScreenUpdating = True
    End Sub
Sumit Saha
  • 1
  • 1