Macro Help - Loop to Tag a Cell with a Name and Add Rows based on a Counter

[Johnny Thunder]

Hello All,

I have a block of Data Sheets("Data Entry").Rows(1:20).EntireRow that is copied x amount of times based on a variable which I have working at this point. Where I am getting stuck is I need to update a cell value based on a counter with a name and number incrementally. So for example, if my block mentioned above is copied 4 times, I would need to update Cell A4 with "Block 1" and then cell A24 with "Block 2", Cell 44 with "Block 3" and Cell 64 with "Block 4".

Once the blocks have been tagged, I have another variable on another sheet that would need to go into each of the blocks and Add rows based on the value. Each block already contains 15 rows of useable space but most blocks will need more than this so for this example:

Block 1 = Needs 17 Rows
Block 2 = Needs 30
Block 3 = Needs 30
Block 4 = Needs 30

The blocks will never need less than 15 rows but at times will only need 15 rows total.

My Counter for the variables is on Sheet "Schedule Report" Column T is used as a count for how many blocks are needed, Column U is the unique values that are driving all the counts, Column V is the Count of how many rows each block needs.

Marketing Timing Model v2.8.xlsb
	T	U	V
1	Counter	Unique Release Year	Row Count
2	Block 1	FY - 2020	17
3	Block 2	FY - 2021	30
4	Block 3	FY - 2022	30
5	Block 4	FY - 2023	30
Schedule Report

Here is my current code: (Missing the loop portion that defines how many rows are needed for each block)

Sub MakeUnique()

Dim ws1                 As Worksheet, ws2 As Worksheet
Dim vaData           As Variant, aOutput() As Variant
Dim colUnique     As Collection
Dim i                       As Long, LastR1 As Long, Count As String

Set ws1 = Sheets("Schedule Report")
Set ws2 = Sheets("Data Entry")

LastR1 = ws1.Cells(Rows.Count, "Q").End(xlUp).Row
Application.DisplayAlerts = False

    'Put the data in an array
    vaData = ws1.Range("Q2:Q" & LastR1).Value

    'Create a new collection
    Set colUnique = New Collection

    'Loop through the data
    For i = LBound(vaData, 1) To UBound(vaData, 1)
        'Collections can't have duplicate keys, so try to
        'add each item to the collection ignoring errors.
        'Only unique items will be added
        On Error Resume Next
            colUnique.Add vaData(i, 1), CStr(vaData(i, 1))
        On Error GoTo 0
    Next i

    'size an array to write out to the sheet
    ReDim aOutput(1 To colUnique.Count, 1 To 1)

    'Loop through the collection and fill the output array
    For i = 1 To colUnique.Count
        aOutput(i, 1) = colUnique.Item(i)
    Next i

    'Write the unique values to column
    ws1.Range("U1").Value = "Unique Release Year"
    ws1.Range("U2").Resize(UBound(aOutput, 1), UBound(aOutput, 2)).Value = aOutput
    
    LastR1 = ws1.Cells(Rows.Count, "U").End(xlUp).Row   'Redefines the New LastR
        ws1.Range("T1").Value = "Counter"
                ws1.Range("T2:T" & LastR1).Formula = "=""Block "" & ROW()-1"
                    ws1.Range ("V1") > Value = "Row Count"
                        ws1.Range("V2:V" & LastR1).Formula = "=COUNTIF(Q:Q,U2)"
                
Count = Application.WorksheetFunction.CountA(ws1.Range("T2:T" & LastR1)) 'Defines how many times to copy the block of data

ws2.Rows("1:20").EntireRow.Copy Range("A1").Resize(20 * Count) 'Creates the Data Blocks

'Need loop here to look at Column T on ws1 to define how many rows to add to each block

End Sub

 

[Johnny Thunder]

Bump?

 

[Johnny Thunder]

Any ideas @DanteAmor ??