VBA Help - Loop Thru List and Copy Value to a Range and repeat to next list value

[Johnny Thunder]

Hello All,

I have a project where I need to populate a list of Movie Titles within a defined range of values that describe a $spend category. This exercise is done weekly so trying to create a script that could build my data quickly.I mocked up a small sample that is similar to what I am looking for.

In this sample, you can see the Title field is blank and the Defined Variable Field is duplicated in 3 seperate Blocks. What I am trying to achieve is the piece of code that would take a look at my list on sheet lookups and grab the first Title and paste it into cells B2:B6 and then loop this process for the next title and do this until all titles have been populated.

Book1
	A	B	C
1	Row	Title	Defined Variable
2	1		Photo
3	2		Marketing
4	3		Publicity
5	4		Media
6	5		Events
7	1		Photo
8	2		Marketing
9	3		Publicity
10	4		Media
11	5		Events
12	1		Photo
13	2		Marketing
14	3		Publicity
15	4		Media
16	5		Events
Sheet1

Book1
	A
1	List of Titles
2	Harry Potter
3	Speed
4	Lion King
5	Aliens 2
Lookups

The End Result should look like this

Book1
	A	B	C
1	Row	Title	Defined Variable
2	1	Harry Potter	Photo
3	2	Harry Potter	Marketing
4	3	Harry Potter	Publicity
5	4	Harry Potter	Media
6	5	Harry Potter	Events
7	1	Speed	Photo
8	2	Speed	Marketing
9	3	Speed	Publicity
10	4	Speed	Media
11	5	Speed	Events
12	1	Lion King	Photo
13	2	Lion King	Marketing
14	3	Lion King	Publicity
15	4	Lion King	Media
16	5	Lion King	Events
17	1	Aliens 2	Photo
18	2	Aliens 2	Marketing
19	3	Aliens 2	Publicity
20	4	Aliens 2	Media
21	5	Aliens 2	Events
Sheet1

Any help on this is appreciated!

 

[Osvaldo Palmeiro]

Hi. Please, try this code.

Sub RepeatData()
 Dim movie As Range, k As Long
  With Sheets("Sheet1")
   .[A2:C6].Copy .[A7].Resize((Application.CountA(Sheets("Lookups").[A:A]) - 2) * 5, 3)
   For Each movie In Sheets("Lookups").Range("A2:A" & Sheets("Lookups").Cells(Rows.Count, 1).End(3).Row)
    .Cells(2 + k, 2).Resize(5) = movie.Value: k = k + 5
   Next movie
  End With
End Sub

 

[Mario_R]

Hello.
The following procedure only requires the 'Lookups' sheet:

a) Take the data from its column A and
b) Create a new sheet with the data structure you requested.

Sub Macro8()
Dim a, b, R&, i&, j%
a = Range("'Lookups'!A1").CurrentRegion
ReDim b(1 To 1 + 5 * (UBound(a) - 1), 1 To 3): R = 1
b(1, 1) = "Row": b(1, 2) = "Title": b(1, 3) = "Defined"
For i = 2 To UBound(a)
  For j = 1 To 5
    R = 1 + R: b(R, 1) = j: b(R, 2) = a(i, 1)
    b(R, 3) = Array("Photo", "Marketing", "Publicity", "Media", "Events")(j - 1)
  Next
Next
With Worksheets.Add(ActiveSheet).[a1].Resize(R, 3)
  .Parent.Cells.Font.Size = 12: .Parent.Rows.RowHeight = 20: .Value = b
End With
End Sub