Take non zero values, and adjacent data, from one sheet and create new table in another sheet - VBA loop - excel

Question

I am trying to take the output from a solver model and condense it into a summary report in another sheet. The Solver screen will be lost each time I run it on new data.
My solver screen looks like this
Solver screenshot. The ideal report output will be this table. Notice that January only has two truckloads (TLs) as Solver output (IF(E4:N4=True,Include TL,n/a). So, the new report should skip TLs #3,4,5 (G4:I4) and fill in the table with next valid output (column J). I will always want to associate the unit quantity (E:N) with a product name (D) in the new report.
I am a super novice VBA user. Here is how far I have got in my VBA to accomplish this:
Sub TL_Report()
Dim c As Range
For Each c In ActiveSheet.Range("e5:e30")
If c.Value <> 0 Then
Worksheets("TL_Report").Range("C" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, 2).Value = Range(c.Offset(0, -1), c).Value
End If
Next c
End Sub
I can figure out how to loop through each column in the solver, but I cannot figure out how to have the new report get reformatted without blanks entries. Any advice on how to write this? Thank you.

Answer 1

According to the data avaiable, i've created this subroutine:
Sub SubReport()
'Declarations.
Dim WksSource As Worksheet
Dim WksReport As Worksheet
Dim WksWorksheet01 As Worksheet
Dim RngMonths As Range
Dim RngTrucks As Range
Dim RngProductList As Range
Dim RngValues As Range
Dim RngTarget As Range
Dim RngRange01 As Range
Dim DblCounter01 As Integer
Dim DblCounter02 As Integer
'Setting WksSource.
Set WksSource = Sheets("TL_Solver")
'Referring to WksSource.
With WksSource
'Setting RngMonths.
Set RngRange01 = .Range("E2")
DblCounter01 = Excel.WorksheetFunction.Min(RngRange01.End(xlToRight).Column, _
.Cells(RngRange01.Row, .Columns.Count).End(xlToLeft).Column _
)
Set RngMonths = .Range( _
RngRange01, _
.Cells(RngRange01.Row, DblCounter01) _
)
'Setting RngTrucks.
Set RngRange01 = .Range("E3")
DblCounter01 = Excel.WorksheetFunction.Min(RngRange01.End(xlToRight).Column, _
.Cells(RngRange01.Row, .Columns.Count).End(xlToLeft).Column _
)
Set RngTrucks = .Range( _
RngRange01, _
.Cells(RngRange01.Row, DblCounter01) _
)
'Setting RngProductList.
Set RngRange01 = RngTrucks.Resize(1, 1).Offset(2, -1)
DblCounter01 = Excel.WorksheetFunction.Min(RngRange01.End(xlDown).Row, _
.Cells(.Rows.Count, RngRange01.Column).End(xlUp).Row _
)
Set RngProductList = .Range( _
RngRange01, _
.Cells(DblCounter01, RngRange01.Column) _
)
'Setting RngValues.
Set RngRange01 = .Cells(RngProductList.Row, RngTrucks.Column)
Set RngValues = RngRange01.Resize(RngProductList.Rows.Count, RngTrucks.Columns.Count)
End With
'Creating a new worksheet for the report.
Set WksReport = ActiveWorkbook.Sheets.Add(After:=WksSource)
'Counting other existing reports if any.
DblCounter01 = 0
For Each WksWorksheet01 In WksReport.Parent.Worksheets()
If Left(WksWorksheet01.Name, 7) = "Report " Then
DblCounter01 = DblCounter01 + 1
End If
Next
'Renaming the current report.
DblCounter02 = DblCounter01
On Error Resume Next
Do Until WksReport.Name = "Report " & DblCounter01
DblCounter01 = DblCounter01 + 1
WksReport.Name = "Report " & DblCounter01
If DblCounter01 - DblCounter02 > 1000 Then GoTo CP_FAILED_RENAMING
Loop
CP_FAILED_RENAMING:
On Error GoTo 0
'Setting RngTarget.
Set RngTarget = WksReport.Range("A1")
'Covering each column in RngValues.
For DblCounter01 = 1 To RngValues.Columns.Count
'Checking if there is any value to report.
If Excel.WorksheetFunction.Sum(RngValues.Columns(DblCounter01).Cells) <> 0 Then
'Inserting the data for the first row of the report's chapter.
With RngTarget
.Offset(0, 1).Value = "Truck #"
.Offset(0, 2).Value = Split(RngTrucks.Cells(1, DblCounter01), "#")(1)
.Offset(0, 3).Value = "Delivery"
If WksSource.Cells(RngMonths.Row, RngTrucks.Columns(DblCounter01).Column).Value = "" Then
.Offset(0, 4).Value = WksSource.Cells(RngMonths.Row, RngTrucks.Columns(DblCounter01).Column).End(xlToLeft).Value
Else
.Offset(0, 4).Value = WksSource.Cells(RngMonths.Row, RngTrucks.Columns(DblCounter01).Column).Value
End If
.Offset(1, 1).Value = "Product"
.Offset(1, 2).Value = "Quantity"
End With
'Offsetting RngTarget by 2 rows in order to enter the data.
Set RngTarget = RngTarget.Offset(2, 0)
'Covering each value in the given column of RngValues.
DblCounter02 = 1
For Each RngRange01 In RngValues.Columns(DblCounter01).Cells
'Checking if the value is not 0.
If RngRange01.Value <> 0 Then
'Inserting the data.
With RngTarget
.Value = DblCounter02
.Offset(0, 1).Value = WksSource.Cells(RngRange01.Row, RngProductList.Column).Value
.Offset(0, 2).Value = RngRange01.Value
End With
DblCounter02 = DblCounter02 + 1
'Offsetting RngTarget to the next row of the report.
Set RngTarget = RngTarget.Offset(1, 0)
End If
Next
'Offsetting RngTarget by 1 row for the next chapter.
Set RngTarget = RngTarget.Offset(1, 0)
End If
Next
'Autofitting the second column of the report.
RngTarget.Offset(0, 1).EntireColumn.AutoFit
End Sub
It dynamically determines the size of the data to process (starting from given cells), it creates a new sheet renamed as "Report n" (based of the n pre-existing sheet already named "Report n") and insert the data as requested.