[SOLVED] Using VBA to loop through a dynamic list of strings and create a summary sheet

Using VBA to loop through a dynamic list of strings and create a summary sheet

I have a list of strings which can vary in length depending on the data. I need to produce a report from this list by creating a row in a new worksheet with the item from the list, then lines of extra information that will be hard coded into the VBA. My approach so far is looping through the list but I am new to looping within VBA so am looking for some guidance.

Here is example source and destination data

Source

| Column A |
| -------- |
|  1       |
|  2       |
|  3       |
|  4       |
|  etc.    |

Destination

| Column A | Column B |
| -------- | -------- |
| 1        | Total    |
|          | a        |
|          | b        |
|          | c        |
| 2        | Total    |
|          | a        |
|          | b        |
|          | c        |

etc..

Values total a,b,c etc will be a values from a data sheet which is calculated e.g. a = value, b = value * 0.3

Below is my example VBA code where I have started and what I would like it to do.

Sub testloop()

Dim counter As Integer
Dim rng As Range
Dim cell As Range
Dim source As Worksheet, destination As Worksheet

source = Worksheets("Sheet1")
destination = Worksheets("Sheet2")
'I have included a counter as my initial research looks to use this logic to stop a loop when it has reached the end of the data
counter = 1
'Not sure if this will loop the whole of column A or just the rows with data
rng = Range("A:A")

For Each cell In rng
    counter = counter + 1
'Now I want to print the data from source into destination
'I am aware the following example code is not correct. Hopefully this illustates my requirement
'e.g.
'copy from "Source.Range(A) & counter"
'paste "Destination.Range (A) & counter

'followed by the next information
'insert "Total" into destination.Range (B) & counter
'insert "a" into destination.Range (B) & counter + 1
'insert "b" into destination.Range (B) & counter + 2
'insert "b" into destination.Range (B) & counter + 3

'^^ Maybe I need a counter2 variable here?

'Then repeat this

Next cell

End Sub

Solution

You can try this approach:

Sub testloop()
Dim counter As Integer
Dim rng As Range
Dim cell As Range
Dim source As Worksheet, destination As Worksheet
    
    Set source = Worksheets("Sheet1")
    Set destination = Worksheets("Sheet2")
    
    Set rng = source.Range("A1:A" & Range("A1").End(xlDown).Row)
    For counter = 0 To rng.Rows.Count - 1
        With destination.Range("A1").Offset(counter * 4)
            .Value = rng.Rows(counter + 1).Value
            .Offset(, 1) = "Total"
            .Offset(1, 1) = "a"
            .Offset(2, 1) = "b"
            .Offset(3, 1) = "c"
        End With
    Next counter
End Sub