Macro Help - Creating a report using data from another sheet

Johnny Thunder

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

I have a spreadsheet that contains data by Genre and Dates that flows left to right on my sheet but I need a way to convert the data into a more traditional style report that flows vertically. I have mocked up some sample data to assist in my explanation so hopefully that helps.

Currently for each genre there is an original amount that is used and then allocated by the user manually across the dates they choose. The total allocation will always equal back to the original. Also, the dates will never have any gaps in the middle of the allocation.

Any help is appreciated. 🙏

Sheet 1 Data
Book1
ABCDEFGHIJKLMNOPQRS
1GenreAmountDate Range: Oct-17Nov-17Dec-17Jan-18Feb-18Mar-18Apr-18May-18Jun-18Jul-18Aug-18Sep-18Oct-18Nov-18Dec-18Jan-19
2Rock $ 750.00 $ 87.50 $ 87.50 $ 87.50 $ 87.50 $ 87.50 $ 87.50 $ 45.00 $ 45.00 $ 45.00 $ 45.00 $ 45.00
3Classical $ 1,200.00 $ 140.00 $ 140.00 $ 140.00 $ 140.00 $ 140.00 $ 140.00 $ 72.00 $ 72.00 $ 72.00 $ 72.00 $ 72.00
4Folk $ 3,000.00 $ 900.00 $ 1,500.00 $ 300.00 $ 300.00
Sheet1


My expected results on Sheet 2
Book1
ABC
1Genre Caluclated Amount Date
2Rock $ 87.50 Dec-17
3Rock $ 87.50 Jan-18
4Rock $ 87.50 Feb-18
5Rock $ 87.50 Mar-18
6Rock $ 87.50 Apr-18
7Rock $ 87.50 May-18
8Rock $ 45.00 Jun-18
9Rock $ 45.00 Jul-18
10Rock $ 45.00 Aug-18
11Rock $ 45.00 Sep-18
12Rock $ 45.00 Oct-18
13Classical $ 140.00 Feb-18
14Classical $ 140.00 Mar-18
15Classical $ 140.00 Apr-18
16Classical $ 140.00 May-18
17Classical $ 140.00 Jun-18
18Classical $ 140.00 Jul-18
19Classical $ 72.00 Aug-18
20Classical $ 72.00 Sep-18
21Classical $ 72.00 Oct-18
22Classical $ 72.00 Nov-18
23Classical $ 72.00 Dec-18
24Folk $ 900.00 May-18
25Folk $ 1,500.00 Jun-18
26Folk $ 300.00 Jul-18
27Folk $ 300.00 Aug-18
Sheet2
 

Excel Facts

Wildcard in VLOOKUP
Use =VLOOKUP("Apple*" to find apple, Apple, or applesauce

DanteAmor

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

VBA Code:
Sub Creating_report()
  Dim sh1 As Worksheet, a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, lc As Long
  Set sh1 = Sheets("Sheet1")
  lr = sh1.Range("A" & Rows.Count).End(3).Row
  lc = sh1.Cells(1, Columns.Count).End(1).Column
  a = sh1.Range("A1", sh1.Cells(lr, lc)).Value2
  ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 3)
  k = 1
  For i = 2 To UBound(a, 1)
    For j = 4 To UBound(a, 2)
      If a(i, j) <> "" Then
        b(k, 1) = a(i, 1)
        b(k, 2) = a(i, j)
        b(k, 3) = a(1, j)
        k = k + 1
      End If
    Next
  Next
  Sheets("Sheet2").Range("A2").Resize(k, 3).Value = b
End Sub
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
Office Version
  1. 2016
Platform
  1. MacOS
Dante! Thanks for providing the code to test. I did get pulled off of the project for a few hours but plan on getting back to it this weekend so I will review and get back to you on the results. Thanks again!
 

Johnny Thunder

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

Thank you for the help on this. So I tested the code and it definitely looks like it will work for what I need. I did run into a bit of an issue. So the sample data I provided was just that, a sample. I was hoping the code would be easy to manipulate to my actual layout for my spreadsheet but it is much more complex then what I am used to.

I am hoping it wouldn't be to hard to revise the code you provide based on the data below, its my actual data with some names removed.

I wanted to point out that my data starts in cell O7, I would need the values from cells O7, P7 repeated on Sheet2 as it builds the report. Also, the Date header that is needed starts in Cell T7:whatever the last column is but remain on row 7. I wanted to also point out as you can see from the sample there will be blank rows in between the data and totals as well, I use column O to drive the code to ensure I don't pick up blank rows and also so that I don't pick up the total.

I highlighted the data in the table below that is needed to build the report on Sheet2 Hopefully its a quick change to the code you provided to make this work. Thanks again for all your help.

Starting Sheet
Sample Table - Dates Grid.xlsx
OPQRSTUVWXYZAAABACADAEAFAGAHAIAJAK
1Q1Q1Q1Q2Q2Q2Q3Q3Q3Q4Q4Q4Q1Q1Q1Q2Q2Q2
2FY19 Q1FY19 Q1FY19 Q1FY19 Q2FY19 Q2FY19 Q2FY19 Q3FY19 Q3FY19 Q3FY19 Q4FY19 Q4FY19 Q4FY20 Q1FY20 Q1FY20 Q1FY20 Q2FY20 Q2FY20 Q2
3FY19FY20
4Marketing CostsControl TotalOct-18Nov-18Dec-18Jan-19Feb-19Mar-19Apr-19May-19Jun-19Jul-19Aug-19Sep-19Oct-19Nov-19Dec-19Jan-20Feb-20Mar-20
5TitleCategoryAmountSum Amount
6
7Title 1 Genre 1 - - $ - $ - $ - $ - $ - $ - $ - $ - $ - $ - $ -
8Title 2 Genre 2 750 750 $ 88 $ 88 $ 88 $ 88 $ 88 $ 88 $ 45 $ 45 $ 45 $ 45 $ 45
9Title 3 Genre 3 1,200 1,200 $ 140 $ 140 $ 140 $ 140 $ 140 $ 140 $ 72 $ 72 $ 72 $ 72 $ 72
10Title 4 Genre 4 500 500 $ 58 $ 58 $ 58 $ 58 $ 58 $ 58 $ 30 $ 30 $ 30 $ 30 $ 30
11Title 5 Genre 5 1,200 1,200 $ 140 $ 140 $ 140 $ 140 $ 140 $ 140 $ 72 $ 72 $ 72 $ 72 $ 72
12Title 6 Genre 6 925 925 $ 108 $ 108 $ 108 $ 108 $ 108 $ 108 $ 56 $ 56 $ 56 $ 56 $ 56
13Title 7 Genre 7 452 452 $ 53 $ 53 $ 53 $ 53 $ 53 $ 53 $ 27 $ 27 $ 27 $ 27 $ 27
14Title 8 Genre 8 3,000 3,000 $ 900 $ 1,500 $ 300 $ 300
15Total 8,027 8,027
16
17Title 9 Genre 9 - - $ - $ - $ - $ - $ - $ - $ - $ - $ - $ - $ -
18Title 10 Genre 10 750 750 $ 88 $ 88 $ 88 $ 88 $ 88 $ 88 $ 45 $ 45 $ 45 $ 45 $ 45
19Title 11 Genre 11 1,200 1,200 $ 140 $ 140 $ 140 $ 140 $ 140 $ 140 $ 72 $ 72 $ 72 $ 72 $ 72
20Title 12 Genre 12 500 500 $ 58 $ 58 $ 58 $ 58 $ 58 $ 58 $ 30 $ 30 $ 30 $ 30 $ 30
21Title 13 Genre 13 1,200 1,200 $ 140 $ 140 $ 140 $ 140 $ 140 $ 140 $ 72 $ 72 $ 72 $ 72 $ 72
22Title 14 Genre 14 925 925 $ 108 $ 108 $ 108 $ 108 $ 108 $ 108 $ 56 $ 56 $ 56 $ 56 $ 56
23Title 15 Genre 15 452 452 $ 53 $ 53 $ 53 $ 53 $ 53 $ 53 $ 27 $ 27 $ 27 $ 27 $ 27
24Title 16 Genre 16 3,000 3,000 $ 900 $ 1,500 $ 300 $ 300
25Total 8,027 8,027
Sheet3


Sheet2 Report (Expected Results)
Sample Table - Dates Grid.xlsx
ABCD
1TitleGenre Caluclated Amount Date
2Title 1Genre 1 $ - FY19 Q1
3Title 1Genre 1 $ - FY19 Q2
4Title 1Genre 1 $ - FY19 Q2
5Title 1Genre 1 $ - FY19 Q2
6Title 1Genre 1 $ - FY19 Q3
7Title 1Genre 1 $ - FY19 Q3
8Title 1Genre 1 $ - FY19 Q3
9Title 1Genre 1 $ - FY19 Q4
10Title 1Genre 1 $ - FY19 Q4
11Title 1Genre 1 $ - FY19 Q4
12Title 1Genre 1 $ - FY20 Q1
13Title 2Genre 2 $ 87.50 FY19 Q1
14Title 2Genre 2 $ 87.50 FY19 Q2
15Title 2Genre 2 $ 87.50 FY19 Q2
16Title 2Genre 2 $ 87.50 FY19 Q2
17Title 2Genre 2 $ 87.50 FY19 Q3
18Title 2Genre 2 $ 87.50 FY19 Q3
19Title 2Genre 2 $ 45.00 FY19 Q3
20Title 2Genre 2 $ 45.00 FY19 Q4
21Title 2Genre 2 $ 45.00 FY19 Q4
22Title 2Genre 2 $ 45.00 FY19 Q4
23Title 2Genre 2 $ 45.00 FY20 Q1
24Title 3Genre 3 $ 140.00 FY19 Q1
25Title 3Genre 3 $ 140.00 FY19 Q2
26Title 3Genre 3 $ 140.00 FY19 Q2
27Title 3Genre 3 $ 140.00 FY19 Q2
28Title 3Genre 3 $ 140.00 FY19 Q3
29Title 3Genre 3 $ 140.00 FY19 Q3
30Title 3Genre 3 $ 72.00 FY19 Q3
31Title 3Genre 3 $ 72.00 FY19 Q4
32Title 3Genre 3 $ 72.00 FY19 Q4
33Title 3Genre 3 $ 72.00 FY19 Q4
34Title 3Genre 3 $ 72.00 FY20 Q1
Sheet2
 

DanteAmor

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

ADVERTISEMENT

I was hoping the code would be easy to manipulate to my actual layout for my spreadsheet but it is much more complex then what I am used to.

Here the updated code with your data provided.
In the code I put some comments to explain it.

VBA Code:
Sub Creating_report()
  Dim sh1 As Worksheet, a As Variant, b As Variant
  Dim i As Long, j As Long, k As Long, lr As Long, lc As Long
  
  Set sh1 = Sheets("Sheet1")
  lr = sh1.Range("O" & Rows.Count).End(3).Row     'last row of column O
  lc = sh1.Cells(2, Columns.Count).End(1).Column  'last column of row 2
  
  'Load in memory all data from cell O1 and to the last cell with data
  a = sh1.Range("O1", sh1.Cells(lr, lc)).Value2
  
  'Calculate an output matrix (1 to rows, 1 to columns)
  'the number of rows will be equal to the number of cells from cell O1 to the last cell
  '(surely there are fewer cells with data, but it is a calculation to size the output matrix)
  'With 4 columns
  ReDim b(1 To UBound(a, 1) * UBound(a, 2), 1 To 4)
  
  For i = 7 To UBound(a, 1)      '7 initial row
    If a(i, 1) <> "" Then
      For j = 6 To UBound(a, 2)  '4 initial column, 1 is column O, 2 column P, ... 6 column T
        If a(i, j) <> "" Then
          k = k + 1
          b(k, 1) = a(i, 1) 'Title
          b(k, 2) = a(i, 2) 'Genre
          b(k, 3) = a(i, j) 'Amount
          b(k, 4) = a(2, j) 'Date
        End If
      Next j
    End If
  Next i
  
  'The process puts the array in the cells, starting in cell A2
  Sheets("Sheet2").Range("A2").Resize(k, 4).Value = b
End Sub
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
Office Version
  1. 2016
Platform
  1. MacOS
@DanteAmor I started on a new project that is very similar to this one with values in different cells but unfortunately I wasn't able to adapt this code to work on the other project. If you have time, do you mind checking out the other post.

 

DanteAmor

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

ADVERTISEMENT

The code in post #5 worked for you?
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
Office Version
  1. 2016
Platform
  1. MacOS
Yes sir! It worked great for that last project. I tried to take your commented sections and update it to fit my new request but I don't know enough about array type of ranges to modify.

Thanks again for all the help in the past. your solutions have always been great!
 

DanteAmor

Well-known Member
Joined
Dec 3, 2018
Messages
12,620
Office Version
  1. 2007
Platform
  1. Windows
Again with pleasure. Thanks for the feedback
 

Johnny Thunder

Well-known Member
Joined
Apr 9, 2010
Messages
677
Office Version
  1. 2016
Platform
  1. MacOS
@DanteAmor I started on a new project that is very similar to this one with values in different cells but unfortunately I wasn't able to adapt this code to work on the other project. If you have time, do you mind checking out the other post.


So, are you able to help out with modifying the code used in this post to the new project?
 

Watch MrExcel Video

Forum statistics

Threads
1,129,563
Messages
5,637,077
Members
416,956
Latest member
mitzhaki

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