I had posted a previous question on this subject that in hindsight was needlessly complicated. I have cut about half of the code from my example and simplified the explanation this time to focus on my underlying question, which is: How do I create a loop to write data to an output range in a way that allows me to both add rows of data to the output range, and also enter data in new columns of existing output rows?
The simplified setup is this. I have a list of source folder names in A5:A14, and the number of items in each folder in B5:B14. The goal is to determine the makeup of all possible output “sets” and write each possible set to a row in output range D18:Lx, with an output set being something like: 1 item from Folder 1; 2 items from Folder 2; etc. (so C18 would be “1”, D18 would be “2”, etc.). Each source folder name contains a “tag” between brackets that indicates how many items from that folder must be included in any output set. In this screenshot of the worksheet, the green cells are the source data, the light blue cells are the output row/column headers, and the dark blue cells are the output item quantities per folder (which is where I need help).
My code already parses each folder name and (1) enters the row/column headers, (2) calculates the number of new rows that must be added to the output after parsing each folder name, and (3)s the running total number of output rows and columns after parsing each folder name. But I am stuck figuring out to go back and write the dark blue output area. The code needs to:
Loop through the source folder cells, which represent the column headers in the output range (screenshot C17:L17). Based on the value of each source cell, I already have the formula to determine how many new output rows are required (RowsNew), the running total of output rows (RowsCount), and what the contents of the output cells should be.
Based on the content of the first source cell, somewhere between 1-9 rows of data will be written to the output range. When the first source cell is parsed, the only data that will entered in the output area will be in the first column (screenshot C18-Cx).
For the second and all subsequent source cells, it is possible that no new rows will be added to the output range (see 3a below). It is also possible that rows will be added, with the number of new rows equal to a formula (see 3b below). In both of these situations, data will be added to the incremental column of the existing output rows.
—- 3a. If RowsNew=0 or 1 for a source cell, it means no new rows are required. But we still need at least one value to be written to all existing rows of the output range, entered in the furthest-right blank output column (the code already knows this column number). So if the first source cell resulted in the value “1” being entered in C18 and RowsNew =1 for the second source cell, we need a value entered in D18. The third source cell would need (if RowsNew=1 for that cell) a number written to E18, and so on.
—- 3b. If RowsNew>1 then new output rows ARE required, and things get trickier. We need to add new output rows equal to RowsCount * RowsNew – RowsCount. So if RowsNew=2, then all existing rows must be duplicated, with the first half (the original rows) receiving a “1” in the furthest-right blank column, and the second half (the new rows) receiving a “2” . If RowsNew=3, then all existing rows must be duplicated twice, with the first third (the original rows) receiving a “1” in the furthest-right column, the second third receiving a “2” and the last third receiving a “ 3”. And so on, since the maximum possible value of RowsNew=9.
Any pointers are greatly appreciated! Thanks.
Dim ws As Worksheet Dim c As Range 'used to reference any cell in a range Dim Folders As Range 'named worksheet range with folder names Dim Items As Range 'named ws range showing number of items in each folder Dim OutputStart As Range 'named ws cell that is 1 cell above and left of output range Dim OutputRange As Range 'named ws range where output will be placed Dim ItemComboRange As Range 'named ws range where actual Item counts are entered (subset of OutputRange) Dim ItemCount As Integer 'count of Items; used in combination calcs Dim RowsNew As Integer 'number of new rows to add to output area Dim RowCount As Integer 'running count of number of rows needed for output Dim ColumnCount As Integer 'running count of number of columns needed for output (not counting first column that just says "Row1", etc.) Dim Tag As String 'the text in each folder name between the brackets Dim Min As Integer 'used to calc min number of Items per folder Dim Max As Integer 'used to calc max number of Items per folder Dim x As Integer 'general counting variable 'Setup Set ws = ActiveSheet Set Folders = ws.Range("B5:B14") 'folder names pre-entered here Set Items = ws.Range("C5:C14") 'count of Items per folder pre-entered here Set OutputStart = ws.Range("B17") Set OutputRange = ws.Range("B17:L18") 'Set up OutputRange.ClearContents ColumnCount = 0 RowCount = 1 'will always be at least one row required in output 'Loop through each folder listed in Folders range, enter column headers, count rows required For Each c In Folders If c.Value = "" Then GoTo NextFolder 'skip this row if empty 'Get folder name & Item count in folder, write headers ColumnCount = ColumnCount + 1 'running folder count; each folder equates to a column of output OutputStart.Offset(0, ColumnCount).Value = c.Value 'enter folder name in top row of output 'extract tag between brackets FromPos = InStr(c, "[") ToPos = InStr(c, "]") Tag = Mid(c, FromPos + 1, ToPos - FromPos - 1) 'grab low and high Item count (if any) and calc rows needed If InStr(1, Tag, "ALL") > 0 Then 'detailed code omitted for clarity ElseIf InStr(1, (Tag), "-") > 0 Then Min = CInt(Left(Tag, 1)) Max = CInt(Right(Tag, 1)) RowsNew = RowCount * (Max - Min + 1) - RowCount 'update new output rows needed RowCount = RowCount + RowsNew 'update total output rows needed ElseIf Tag = "1" Then 'detailed code omitted for clarity ElseIf Tag > 1 And Tag <= 9 Then 'detailed code omitted for clarity Else 'This means there is a malformed tag MsgBox "I have detected a malformed tag. Macro will now exit. All hell is about to break loose. Hope you saved the file before you ran this code!" Exit Sub End If NextFolder: Next c 'Write output data 'Define output ranges based on row & column counts Set OutputRange = Range(OutputStart, OutputStart.Offset(RowCount, ColumnCount)) Set ItemComboRange = Range(OutputStart.Offset(1, 1), OutputStart.Offset(RowCount, ColumnCount)) 'Write row headers For x = 1 To RowCount OutputStart.Offset(x, 0).Value = "Row" & x Next x x = 0 'reset counter 'NEXT STEPS: How to write data to output range (ItemComboRange)? End Sub