VBA, Excel macros: copy cell value to another sheet, offset, repeat until finding an empty cell

Question

screenshot - cell values have been changed for simplicity I am new to VBA and need to build a data processing pipeline for mass spectrometry data. The instrument generates an output data file always in the same format: 9 columns (A-I), column B has 35 rows for every sample (that is because the instrument quantifies 35 analytes in every sample and reports each analysis as an individual result, every analysis report corresponds to a row; all rows with the same sample name -35- correspond to the same sample). Column H is the most important one; this column contains the quantified values for each of the 35 analytes. Here, 35 rows (for 35 analytes) correspond to the same sample (have the same sample name in column B).

There are a couple of things I need and I cannot figure out what would be the best strategy:

Starting with cell B2 in the original instrument report (for all intents and purposes, this would be an Excel spreadsheet), in an Excel file with multiple sheets, to build the list of sample names I need to:

1. copy the report cell value (B2) only (no formats, e.g.), and paste it in a second spreadsheet (at A3).
2. Offset 35 cells down in the original report; offset one cell down in the destination sheet
3. copy the report cell value (B36) only, and paste it in the spreadsheet from #1 above (at A4)

I need to repeat this (B72 in report to A5 in destination, B107 in report to A6 in destination, etc.) until the report cell is empty. This stops the first task.

The second task is to move to column H in the instrument report spreadsheet, pick the first 35 numerical values (always starting at H2) and transpose them to a row in a second spreadsheet (same as #1 above) that matches the sample names. That is,

1.1. copy range H2:H37 in the report spreadsheet 1.2. paste.special (transpose) to the row starting in cell B3 in a second spreadsheet (same as #1 above) 1.3. offset to range H38:H73 in report; offset one cell down in destination sheet 1.4. copy range H:38-H:73, paste.special (transpose) to row starting at B4 in a second spreadsheet (same as #1 above)

And so forth until I enter all the data in the report file.

This is what I got so far:

    Sub transpose()

Sheets("RAW").Select
Range("D2:D36").Select
Selection.Copy
Sheets("transpose").Select
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, transpose:=True


Sheets("RAW").Activate
Range("B2").Select

  Do Until IsEmpty(ActiveCell)

Worksheets("transpose").Range("B3") = Worksheets("RAW").Range("B2").Value

     ActiveCell.Offset(1, 0).Select
  Loop

    End Sub

my other macros

     Sheets("raw").Select
Range("D2:D36").Select
Selection.Copy
Sheets("transposed").Select
Range("B2").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, transpose:=True

Sheets("raw").Select
Range("B2").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("transposed").Select
Range("A4").Select
ActiveSheet.Paste

Sheets("raw").Select
Range("H2:H36").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("transposed").Select
Range("B4").Select
Selection.PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
    False, transpose:=True 
   ...

It seems like I want to combine both of these into one. I am having trouble with that, maybe my strategy is not the best.

Any help/comments would be greatly appreciated!

Answer 1

To do it in a fast way, I suggest using as less interaction with the sheets as possible. This way the following code "should" run pretty fast and efficient:

Sub test()

  Dim output() As Variant, holder As Variant, i As Long

  'get the whole range (values) which is important
  With Sheets("Source Sheet")
    holder = .Range(.Range("B2").End(xlDown), .Range("H2")).Value
  End With

  'resize the output-array as we need it
  ReDim output(1 To Int(UBound(holder) / 35), 1 To 36)

  'run for every "line" in the values
  For i = 1 To UBound(output) * 35

    'every "first" line get the "header"
    If i Mod 35 = 1 Then output((i - 1) / 35 + 1, 1) = holder(i, 1)

    'all lines get the value
    output(Int((i - 1) / 35 + 1), (i - 1) Mod 35 + 2) = holder(i, 7)
  Next

  'output everything at the desired range
  Sheets("Output Sheet").Range("A3").Resize(UBound(output), 36).Value = output

End Sub

Should be self-explaining, but if you still have any questions, just ask.
(Tested with 315 lines of data => no errors / faults => took less than 1 second)

Answer 2

As the comments are suggesting, there are better (and easier) ways to go about this task. The first step is to try and move away from a recording keystrokes style of programming which is what .Activate/.Select code tends to be. The second would be to think through how the data needs to be manipulated programmatically. In your case, it's seems to be: you need an n x 36 two-dimensional array where n is your raw data length / 35. The second dimension holds every 35th item in Column "B" and then every 35 items of column "H".

Once you have this outline, then the coding becomes straight forward. The sample below is very much a skeleton one (eg there are better ways than .UsedRange to scope the data and I've hard-coded many of the values), but it should at least give you an idea of different coding philosophy:

Dim data As Variant
Dim output() As Variant
Dim n As Long
Dim i As Long
Dim r As Long
Dim c As Integer

'Read the data
data = ThisWorkbook.Worksheets("raw").UsedRange.Value2

'Calculate the number of records and size the output array
n = (UBound(data, 1) - 1) / 35
ReDim output(1 To n, 1 To 36)

'Transfer the data
i = 2 'first row of raw data
For r = 1 To n
    output(r, 1) = data(i, 2)
    For c = 2 To 36
        output(r, c) = data(i, 8)
        i = i + 1
    Next
Next

'Write the output
ThisWorkbook.Worksheets("output").Range("A3").Resize(n, 36).Value = output