Excel VBA - Go through range and copy each cell 9 times - vba

Question

I have a spreadsheet with data as follows:
G H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD ... etc.
2 1
3 2
4 4 8 12 16 20 24 28 32 36 40
5 8 16 24 32 40
That is, G2 = 1, G3 = 1 ... M4 = 28 and so on...
What I need help with is going through this range, which can be dynamic as people are entering data into this range when they need to change stuff. I need to iterate through the rows and then columns and, for each cell that has a value, I need to paste it into a different sheet in column D, 9 times for each cell.
That is, on the 2nd sheet, the data above would come across as:
Column
D
1
1
1
1
1
1
1
1
1
2
2
2
2
2
2
2
2
2
4
4
.. etc...
How do I iterate through each row, and then each column and then for each cell that has a value, copy that 9 times into column D on another sheet, and then for the next cell with a value, copy that BELOW what was pasted and so on?

Answer 1

Try the following. It assumes you want to go column by column iterating through all the populated cells in that column, repeating the value 9 times.
Option Explicit
Public Sub OutputRepeatedValues()
Dim arr()
Const DELIMITER As String = ","
Const NUMOFTIMES As Long = 9
With ThisWorkbook.Worksheets("Sheet1")
arr = .Range(.Range("G2"), .Range("G2").SpecialCells(xlLastCell)).Value
End With
Dim i As Long, j As Long, output As String
For i = LBound(arr, 2) To UBound(arr, 2) '<== iterate rows with a column, column by column
For j = LBound(arr, 1) To UBound(arr, 1)
If Not IsEmpty(arr(j, i)) Then output = output & Replicate(arr(j, i), NUMOFTIMES, DELIMITER)
Next j
Next i
output = Left$(output, Len(output) - 1)
ThisWorkbook.Worksheets("Sheet2").Range("B1").Resize(Len(output), 1) = Application.WorksheetFunction.Transpose(Split(output, DELIMITER))
End Sub
'Adapted from #this https://codereview.stackexchange.com/questions/159080/string-repeat-function-in-vba?utm_medium=organic&utm_source=google_rich_qa&utm_campaign=google_rich_qa
Public Function Replicate(ByVal RepeatString As String, ByVal NUMOFTIMES As Long, Optional ByVal DELIMITER As String = ",")
Dim s As String, c As Long, l As Long, i As Long
l = Len(RepeatString) + 1
c = l * NUMOFTIMES
s = Space$(c)
For i = 1 To c Step l
Mid(s, i, l) = RepeatString & DELIMITER
Next i
Replicate = s
End Function
Notes:
Test dataset laid out as shown below
I assume that you want to work with what ever data is down or the right of G2, including G2. In order to do this I am using SpecialCells(xlLastCell) to find the last used cell. I then construct a range with .Range(.Range("G2"), .Range("G2").SpecialCells(xlLastCell)), which in this case is $G$2:$Q$5, and read that into an array.
Assume that you indeed iterate rows with a column before moving onto next column as described in your question. I concatenate the populated cells values whilst at the same time calling the Replicate function described in 4).
I have hijacked, and adapted, a performant function by #this, to handle the string repeat. I have added in an optional argument for delimiter. A delimiter is added so I can later split on this to write out the results to individual cells within the target worksheet.
I split the string, output, on the delimiter, this creates an array of the repeated values, which I transpose, so I can write out to a column in the target sheet.
Example output:
Edit:
If instead you want to loop the rows, then columns, use with the above function the following instead:
Public Sub OutputRepeatedValues()
Dim arr()
Const DELIMITER As String = ","
Const NUMOFTIMES As Long = 9
With ThisWorkbook.Worksheets("Sheet1")
arr = .Range(.Range("G2"), .Range("G2").SpecialCells(xlLastCell)).Value
End With
Dim i As Long, j As Long, output As String
For i = LBound(arr, 1) To UBound(arr, 1) '<== iterate rows with a column, column by column
For j = LBound(arr, 2) To UBound(arr, 2)
If Not IsEmpty(arr(i, j)) Then output = output & Replicate(arr(i, j), NUMOFTIMES, DELIMITER)
Next j
Next i
output = Left$(output, Len(output) - 1)
ThisWorkbook.Worksheets("Sheet2").Range("B1").Resize(Len(output), 1) = Application.WorksheetFunction.Transpose(Split(output, DELIMITER))
End Sub

Answer 2

My vba is rusty but I think this (pseudo) code might help you.
def last_row as integer, last_col as integer, row as integer, col as integer, target as integer
'I like something like this to get the value but you have to know the largest column: Cells(Rows.Count, col_to_check).End(xlUp).Row
target = 1
for col = 7 to last_col '7 = G
for row = 2 to last_row
if(Not IsEmpty(Cells(row,col)) then
Range(Cells(target*9-8, 4), Cells(target*9, 4))= Cells(row,col)
target = target +1
end
next row
next col
this iterates through all cols and rows checks if there is a value and the copies it to a 9-cell range then iterates the target so it will point to the next 9 cells.