VBA Help - Build Report from Horizontal Data

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
Office Version
  1. 2016
Platform
  1. MacOS
Hi Everyone,

I am working on a project that takes manually entered data in a horizontal layout and converts into a vertical data table. I have already built several things in the workbook to automate the process of data entry but am now stuck on the portion that will convert the data into a more vertical style data table.

Here is what the current report looks like:

PreRoll Working File V1.xlsm
ABCDEFGHIJKLMNOPQRST
1Week To Copy:Friday, May 15, 2020
2
3PreCheck 1PreCheck 1PreCheck 1PreCheck 1PreCheck 2PreCheck 2PreCheck 2PreCheck 2
4Comment:Example Comment: 4th of July Coming SoonPreCheck 1PreCheck 2
5LineOrder NoProductSeasonalCountStart DateProduct TypeClassPre AwarenessSustain length in daysEnd DatePromoSeasonalActionDatePromoSeasonalActionDate
61100001WrenchS010111/1/20Hand ToolsConsumerSkip2811/29/20Summer SaleSummer25% Sale11/15/20FallClearance Sale11/20/20
72100002HammerS010211/1/20Hand ToolsConsumerSkip2811/29/20SpringClearance Sale11/21/20
83100003DrillS010311/1/20Hand ToolsConsumerSkip2811/29/20Home ImprovementDisplay11/7/20Tool TimeBanner11/7/20
94100004Tool BeltS010411/8/20Hand ToolsConsumerSkip2812/6/20ToolmanWinterDisplay11/30/20
Mock Data


For the sample data my PreChecks end at #2 but my working file goes out to #5 so will need to factor that in with any suggestions made.

What I am hoping to achieve is to Paste the values from Column A:K in a new Sheet "Mock Table" and append the Precheck Comments to the right of the data and also include the Precheck number at the end of the pasted data. There are occasions where there is more than one PreCheck that happen on the same row which is why I need to spin the data into a more vertical style table (see below example).

Here is what I am hoping the new Table would look like. You can see in the example Row 2 And 3 have the same details from Columns A:K but the PreCheck data was from two different numbers. This is what I am hoping to achieve. Also, in the event that there is no data in the Precheck fields the code will skip that section and move to the next. Any ideas are appreciated. 💡

PreRoll Working File V1.xlsm
ABCDEFGHIJKLMNOP
1LineOrder NoProductSeasonalCountStart DateProduct TypeClassPre AwarenessSustain length in daysEnd DatePromoSeasonalActionDateCheck Status
21100001WrenchS010144136Hand ToolsConsumerSkip2811/29/20Summer SaleSummer25% Sale11/15/20PreCheck 1
31100001WrenchS010144136Hand ToolsConsumerSkip2811/29/20FallClearance Sale11/20/20PreCheck 2
42100002HammerS010244136Hand ToolsConsumerSkip2811/29/20SpringClearance Sale11/21/20PreCheck 2
53100003DrillS010344136Hand ToolsConsumerSkip2811/29/20Home ImprovementDisplay11/7/20PreCheck 1
63100003DrillS010344136Hand ToolsConsumerSkip2811/29/20Tool TimeBanner11/7/20PreCheck 2
74100004Tool BeltS010444143Hand ToolsConsumerSkip2812/6/20ToolmanWinterDisplay11/30/20PreCheck 2
Mock Table
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,620
Office Version
  1. 2007
Platform
  1. Windows
Try this

VBA Code:
Sub Build_Report()
  Dim a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, lc As Long, m As Long
  
  With Sheets("Mock Data")
    lr = .Range("A" & Rows.Count).End(3).Row
    lc = .Cells(5, Columns.Count).End(1).Column
    a = .Range("A4", Sheets("Mock Data").Cells(lr, lc)).Value2
  End With
  ReDim b(1 To UBound(a) * Int((lc - 11) / 4), 1 To 16)
  
  For i = 3 To UBound(a, 1)
    For j = 12 To UBound(a, 2) Step 5
      If a(i, j) & a(i, j + 1) & a(i, j + 2) & a(i, j + 3) <> "" Then
        m = m + 1
        For k = 1 To 11
          b(m, k) = a(i, k)
        Next k
        b(m, 12) = a(i, j)
        b(m, 13) = a(i, j + 1)
        b(m, 14) = a(i, j + 2)
        b(m, 15) = a(i, j + 3)
        b(m, 16) = a(1, j)
      End If
    Next j
  Next i
  
  Sheets("Mock Table").Range("A2").Resize(m, 16).Value = b
End Sub
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
Office Version
  1. 2016
Platform
  1. MacOS
That was amazing! Worked exactly how I needed it.

I am still super confused on how these style of macros work but they work great!

Thanks again Dante!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,620
Office Version
  1. 2007
Platform
  1. Windows
I'm glad to help you. Thanks for the feedback.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,528
Messages
5,636,852
Members
416,945
Latest member
Himu

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top