VBA: Using Nested Loops to expand a summarised table.

Paddycrook

New Member
Joined
Oct 14, 2013
Messages
4
Hi Everyone

I would like to start off by saying I am a complete newbie to VBA. I have been trying to do this for hours now and just ended up confusing myself.

As far as I can tell there needs to be a nested loop with some kind of variable inside a variable, but to be honest it's well beyond my current skill level... I thought rather than confusing everyone reading this post and embarrassing myself with my poor code, I would just put the before and after tables to simplify things. It might also be less complicated than what I thought. If anone feels like helping me out I would be very greatful :)

I have the file hosted on my Google Docs below.
https://docs.google.com/file/d/0B73mVtKj5WFvY0RDQzZBYTJfb0k/edit?usp=sharing

Thanks! :biggrin:
Paddy

Company
ItemQuantityCosts
TescoCheese4£50
TescoMilk5£50
TescoBread7£50
TescoButter2£50
WalmartPencils3£50
WalmartCabbages9£50
WalmartCheese2£50
WalmartBalls8£50
WalmartPaper2£50
WalmartMeat4£50
MorrisonsPens6£100
MorrisonsGoats Milk9£100
MorrisonsCrabs5£100
MorrisonsApples3£100
MorrisonsOranges5£100
MorrisonsMilk9£100
MorrisonsToothpast6£100

<tbody>
</tbody>


to

Company
Item Costs
TescoCheese £ 12.50
TescoCheese £ 12.50
TescoCheese £ 12.50
TescoCheese £ 12.50
TescoMilk £ 10.00
TescoMilk £ 10.00
TescoMilk £ 10.00
TescoMilk £ 10.00
TescoMilk £ 10.00
TescoBread £ 7.14
TescoBread £ 7.14
TescoBread £ 7.14
TescoBread £ 7.14
TescoBread £ 7.14
TescoBread £ 7.14
TescoBread £ 7.14
TescoButter £ 25.00
TescoButter £ 25.00
WalmartPencils £ 16.67
WalmartPencils £ 16.67
WalmartPencils £ 16.67
WalmartCabbages £ 5.56
WalmartCabbages £ 5.56
WalmartCabbages £ 5.56
WalmartCabbages £ 5.56
WalmartCabbages £ 5.56
WalmartCabbages £ 5.56
WalmartCabbages £ 5.56
WalmartCabbages £ 5.56
WalmartCabbages £ 5.56
WalmartCheese £ 25.00
WalmartCheese £ 25.00
WalmartBalls £ 6.25
WalmartBalls £ 6.25
WalmartBalls £ 6.25
WalmartBalls £ 6.25
WalmartBalls £ 6.25
WalmartBalls £ 6.25
WalmartBalls £ 6.25
WalmartBalls £ 6.25
WalmartPaper £ 25.00
WalmartPaper £ 25.00
WalmartMeat £ 12.50
WalmartMeat £ 12.50
WalmartMeat £ 12.50
WalmartMeat £ 12.50
MorrisonsPens £ 16.67
MorrisonsPens £ 16.67
MorrisonsPens £ 16.67
MorrisonsPens £ 16.67
MorrisonsPens £ 16.67
MorrisonsPens £ 16.67
MorrisonsPens £ 16.67
MorrisonsGoats Milk £ 11.11
MorrisonsGoats Milk £ 11.11
MorrisonsGoats Milk £ 11.11
MorrisonsGoats Milk £ 11.11
MorrisonsGoats Milk £ 11.11
MorrisonsGoats Milk £ 11.11
MorrisonsGoats Milk £ 11.11
MorrisonsGoats Milk £ 11.11
MorrisonsGoats Milk £ 11.11
MorrisonsCrabs £ 20.00
MorrisonsCrabs £ 20.00
MorrisonsCrabs £ 20.00
MorrisonsCrabs £ 20.00
MorrisonsCrabs £ 20.00
MorrisonsApples £ 33.33
MorrisonsApples £ 33.33
MorrisonsApples £ 33.33
MorrisonsOranges £ 20.00
MorrisonsOranges £ 20.00
MorrisonsOranges £ 20.00
MorrisonsOranges £ 20.00
MorrisonsOranges £ 20.00
MorrisonsMilk £ 11.11
MorrisonsMilk £ 11.11
MorrisonsMilk £ 11.11
MorrisonsMilk £ 11.11
MorrisonsMilk £ 11.11
MorrisonsMilk £ 11.11
MorrisonsMilk £ 11.11
MorrisonsMilk £ 11.11
MorrisonsMilk £ 11.11
MorrisonsToothpaste £ 16.67
MorrisonsToothpaste £ 16.67
MorrisonsToothpaste £ 16.67
MorrisonsToothpaste £ 16.67
MorrisonsToothpaste £ 16.67
MorrisonsToothpaste £ 16.67
MorrisonsToothpaste £ 16.67

<tbody>
</tbody>
 

Excel Facts

Which came first: VisiCalc or Lotus 1-2-3?
Dan Bricklin and Bob Frankston debuted VisiCalc in 1979 as a Visible Calculator. Lotus 1-2-3 debuted in the early 1980's, from Mitch Kapor.

ChrisM

Well-known Member
Joined
Jun 11, 2002
Messages
2,129
Give this code a shot. You need to highlight your desired range, including headers, then run this code. It will output the results three rows below your highlighted section (and will overwrite anything there)

Code:
Sub test()

Dim rRange As Range
Dim rOutput As Range
Dim lRows As Long
Dim aTemp As Variant
Dim i As Long, k As Long
Dim sCurrCo As String
Dim lcount As Long
Dim dCurrCost As Double

Set rRange = Selection 'A1:Dxxx

lRows = Application.WorksheetFunction.Sum(rRange.Resize(, 1).Offset(1, 2))

ReDim aTemp(1 To lRows + 1, 1 To 3)

aTemp(1, 1) = rRange.Range("A1") 'write headers
aTemp(1, 2) = rRange.Range("B1")
aTemp(1, 3) = rRange.Range("D1")

lcount = 2
For i = 2 To rRange.Rows.Count
    dCurrCost = rRange.Cells(i, 4) / rRange.Cells(i, 3)
    For k = 1 To rRange.Cells(i, 3)
        aTemp(lcount, 1) = rRange.Cells(i, 1) 'company
        aTemp(lcount, 2) = rRange.Cells(i, 2) 'item
        aTemp(lcount, 3) = dCurrCost 'cost per
        lcount = lcount + 1
    Next k
Next i

'now write array to sheet, 3 rows below source range
Selection.Resize(1, 1).Offset(rRange.Rows.Count + 3, 0).Resize(lRows + 1, 3) = aTemp 'this is really ugly!!

Set rOutput = Nothing
Set rRange = Nothing

End Sub
 

ChrisM

Well-known Member
Joined
Jun 11, 2002
Messages
2,129
I should have read the range in to an array, I don't know why I read it into a Range object, I was thinking along different lines at the beginning I guess. Oh well, it still works fine.
 

Paddycrook

New Member
Joined
Oct 14, 2013
Messages
4
Thanks! I have no clue how this works but it does :) Will probably do a bit of homework just working out the hows and whys of it. Really great stuff though - much appreciated!
 

Forum statistics

Threads
1,171,794
Messages
5,877,553
Members
433,265
Latest member
Umaratnam

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