Help creating VBA Maco for Excel 2010 for auto-generate large spreadsheet

I'm in a bind and could use a hand.  I'm not as familiar with VBA as I need to be, and I'm trying to learn on the fly.  I have a daunting work task that I need to automate ASAP.  I may have some follow up questions because I'm trying to simplify this as much as possible to understand the basic syntax.  

Sheet1 is blank
Sheet2 contains a list of 50 states in column A, and 8 stores in column B.

I need to create a macro that will perform a Do While Loop (or maybe an array?) that will insert the following onto Sheet1:

State1     Store1
State1     Store2
State1     Store3
State1     Store4
State1     Store5
State1     Store6
State1     Store7
State1     Store8

State2     Store1
State2     Store2
State50 Store8

We may need to add to the states column in the future (e.g. add Washington D.C. or Puerto Rico) so I need to have room to expand that (not for this case, but down the road it will be a button for the user to click and generate a new sheet with the updated information).

I think this will require two Do While Loops: one to go through all the states (column A) and one for the stores (Column B).  

Time is critical so I'm offering up 500 pts to the best answer.  

Who is Participating?
nutschConnect With a Mentor Commented:
Try the attached code

Dim lLastRow1 As Long, lLastRow2 As Long
Dim lLoop As Long, lRowDest As Long

'turn off updates to speed up code execution
With application
    .ScreenUpdating = False
    .EnableEvents = False
    .Calculation = xlCalculationManual
End With

lLastRow1 = Sheets("Sheet2").Cells(Rows.Count, 1).End(xlUp).Row
lLastRow2 = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Row

lRowDest = 1

For lLoop = 1 To lLastRow1
    Sheets("Sheet1").Cells(lRowDest, 1).Resize(lLastRow2).Value = Sheets("Sheet2").Cells(lLoop, 1).Value
    Sheets("Sheet2").Cells(1, 2).Resize(lLastRow2).Copy Sheets("Sheet1").Cells(lRowDest, 2)
    lRowDest = lRowDest + lLastRow2

With application
    .ScreenUpdating = True
    .EnableEvents = True
    .Calculation = xlCalculationAutomatic
End With

End Sub

Open in new window

richeckerAuthor Commented:
Much appreciated Nutsch!  This worked just as I needed it to.
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.