[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 367
  • Last Modified:

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.  

Thanks!
0
richecker
Asked:
richecker
1 Solution
 
nutschCommented:
Try the attached code

Sub OUTERJOIN()
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
Next

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

End Sub

Open in new window

0
 
richeckerAuthor Commented:
Much appreciated Nutsch!  This worked just as I needed it to.
0

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Tackle projects and never again get stuck behind a technical roadblock.
Join Now