VBA Looping with 2 variables

blackorchids2002

blackorchids2002

Board Regular
Joined
Dec 29, 2011
Messages
138
Hi Everyone,

I need your expertise again. Below is only part of the code I'm trying to generate.

What I'm trying to achieve is how to loop the ALoc1, ALoc2 etc. to assign the value fromCells(5 + i, 5) in the PPSheet.

In default, ALoc1 is equal to SchedA.Range("B6")
and I wanted to change the value from the PPSheet. I wanted to change the number ALoc1 as I loop it.



Sub testprice()
Set SchedA = Sheets("Schedule A")
Set PPSheet = Sheets("Project Pricing Summary")

For i = 1 To 10
'Declaration of Avaya H&S no. Location or Service Type in the PP Summary sheet
ALoc1 = SchedA.Range("B6")
ALoc2 = SchedA.Range("B13")
ALoc3 = SchedA.Range("B20")
ALoc4 = SchedA.Range("B27")
ALoc5 = SchedA.Range("B34")
ALoc6 = SchedA.Range("B41")
ALoc7 = SchedA.Range("B48")
ALoc8 = SchedA.Range("B55")
ALoc9 = SchedA.Range("B62")
ALoc10 = SchedA.Range("B69")

If PPSheet.Cells(5 + i, 5) <> "" Then
PPSheet.Select
Cells(5 + i, 5).Select
ALoc1 = Cells(5 + i, 5)


End If
Next i
End Sub

Thanks,
blackorchids
 
Sort by date Sort by votes
Try something like this...

Code: 
[color=darkblue]Sub[/color] testprice()
    
    [color=darkblue]Dim[/color] SchedA [color=darkblue]As[/color] Worksheet, PPSheet [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] Aloc [color=darkblue]As[/color] [color=darkblue]Variant[/color], i [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    [color=darkblue]Set[/color] SchedA = Sheets("Schedule A")
    [color=darkblue]Set[/color] PPSheet = Sheets("Project Pricing Summary")
    
    [color=green]'Declaration of Avaya H&S no. Location or Service Type in the PP Summary sheet[/color]
    Aloc = Array("B6", "B13", "B20", "B34", "B41", "B48", "B55", "B62", "B69")
    
    [color=darkblue]For[/color] i = 0 [color=darkblue]To[/color] 9
        [color=darkblue]If[/color] PPSheet.Cells(6 + i, 5) <> "" [color=darkblue]Then[/color]
            SchedA.Range(Aloc(i)) = PPSheet.Cells(6 + i, 5)
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] i
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
Hi Alphafrog,

I figure it out already but your code is more simple. I will use it.

Thanks for your prompt reply. :-):)


AlphaFrog said:
Try something like this...

Code: 
[COLOR=darkblue]Sub[/COLOR] testprice()
    
    [COLOR=darkblue]Dim[/COLOR] SchedA [COLOR=darkblue]As[/COLOR] Worksheet, PPSheet [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] Aloc [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] SchedA = Sheets("Schedule A")
    [COLOR=darkblue]Set[/COLOR] PPSheet = Sheets("Project Pricing Summary")
    
    [COLOR=green]'Declaration of Avaya H&S no. Location or Service Type in the PP Summary sheet[/COLOR]
    Aloc = Array("B6", "B13", "B20", "B34", "B41", "B48", "B55", "B62", "B69")
    
    [COLOR=darkblue]For[/COLOR] i = 0 [COLOR=darkblue]To[/COLOR] 9
        [COLOR=darkblue]If[/COLOR] PPSheet.Cells(6 + i, 5) <> "" [COLOR=darkblue]Then[/COLOR]
            SchedA.Range(Aloc(i)) = PPSheet.Cells(6 + i, 5)
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Click to expand...
 
Upvote 0
Hi AlphaFrog,

With your code below on the array, I've got a problem. Starting from "B6", I will not have an issue but as I loop the value on the array "B13" it should be change 20 "B26." I have added rows on my procedure as I need it. The array shoulde be adjustable by adding the rows code +(RowIns - 4).

I would need to change the array, Aloc = Array("B6", "B" & 13+ (RowIns - 4), "B" & 20 + (RowIns - 4), "B" & 27+ (RowIns - 4), "B" & 34 + (RowIns - 4), "B" & 41+(RowIns - 4), "B"& 48(RowIns - 4), "B"& 55+(RowIns - 4), "B"& 62+ (RowIns - 4), "B"& 69+(RowIns - 4)).

Hope you understand what I'm trying to come up. Many thanks in advance!!!

Sub testprice2()

Dim SchedA As Worksheet, PPSheet As Worksheet
Dim Aloc As Variant


Sheets("Schedule A").Delete
Sheets("Template").Visible = True
Sheets("Template").Select
Sheets("Template").Copy Before:=Sheets(3)
Sheets("Template (2)").Name = "Schedule A"
Sheets("Template").Visible = False

Set SchedA = Sheets("Schedule A")
Set PPSheet = Sheets("Project Pricing Summary")
PPSheet.Select

'Declaration of Avaya H&S no. Location or Service Type in the PP Summary sheet
Aloc = Array("B6", "B13", "B20", "B27", "B34", "B41", "B48", "B55", "B62", "B69")


For k = 0 To 9
If PPSheet.Cells(6 + k, 5) <> "" Then
Cells(6 + k, 5).Select
ActiveCell.Offset(0, -4).Select
ActiveCell.FormulaR1C1 = _
"=COUNTIFS('Entry Sheet'!C28,'Entry Sheet'!R1C26&RC[4],'Entry Sheet'!C21,""<>0"")"
RowIns = ActiveCell
SchedA.Range(Aloc(k)) = PPSheet.Cells(6 + k, 5)
SchedA.Select
Range(Aloc(k)).Select
ActiveCell.Offset(2, 0).Select

For x = 1 To (RowIns - 4)
ActiveCell.EntireRow.Select
y = ActiveCell.Row
Rows(x + y).Insert Shift:=xlDown
Rows(x + y).RowHeight = 17.25
Next x
PPSheet.Select

Else
Exit For
End If
Next k

End Sub







AlphaFrog said:
Try something like this...

Code: 
[COLOR=darkblue]Sub[/COLOR] testprice()
    
    [COLOR=darkblue]Dim[/COLOR] SchedA [COLOR=darkblue]As[/COLOR] Worksheet, PPSheet [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] Aloc [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Variant[/COLOR], i [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] SchedA = Sheets("Schedule A")
    [COLOR=darkblue]Set[/COLOR] PPSheet = Sheets("Project Pricing Summary")
    
    [COLOR=green]'Declaration of Avaya H&S no. Location or Service Type in the PP Summary sheet[/COLOR]
    Aloc = Array("B6", "B13", "B20", "B34", "B41", "B48", "B55", "B62", "B69")
    
    [COLOR=darkblue]For[/COLOR] i = 0 [COLOR=darkblue]To[/COLOR] 9
        [COLOR=darkblue]If[/COLOR] PPSheet.Cells(6 + i, 5) <> "" [COLOR=darkblue]Then[/COLOR]
            SchedA.Range(Aloc(i)) = PPSheet.Cells(6 + i, 5)
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] i
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Click to expand...
 
Upvote 0
I'm not sure I understand exactly, but you could use (RowIns - 4) with the Offset property. Maybe try something like this...
Range(Aloc(k)).Offset(RowIns - 4).Select

Or depending how your description is interpreted, maybe this...
Range(Aloc(k)).Offset((RowIns - 4)*k).Select
 
Upvote 0
Hi Alphafrog,

I thank you for your time in responding my inquiry. Maybe, I wasn't really clear enough in explaining the problem.

Originally, the first code you provided works perfectly if I don't have to add rows as I loop it.

Here is now the problem...
The array code below will change except for "B6" because I need to add rows starting B8. The number of rows may vary depending on the number of records to be extracted. So the array ALoc "B13" and etc. will no longer be the same as B13 range. Why? if from B6, I have a added 14 rows then B13 would be B20. That is why I have tried to put (RowIns-4) inside the array formula but it doesn't work.

'Declaration of Avaya H&S no. Location or Service Type in the PP Summary sheet
Aloc = Array("B6", "B13", "B20", "B34", "B41", "B48", "B55", "B62", "B69")


How then the array code to work where it no longer be a fix range? This is the code I put in "Aloc = Array("B6", "B" & 13+ (RowIns - 4), "B" & 20 + (RowIns - 4), "B" & 27+ (RowIns - 4), "B" & 34 + (RowIns - 4), "B" & 41+(RowIns - 4), "B"& 48(RowIns - 4), "B"& 55+(RowIns - 4), "B"& 62+ (RowIns - 4), "B"& 69+(RowIns - 4))" but not working.


Many thanks in advance. :-)




AlphaFrog said:
I'm not sure I understand exactly, but you could use (RowIns - 4) with the Offset property. Maybe try something like this...
Range(Aloc(k)).Offset(RowIns - 4).Select

Or depending how your description is interpreted, maybe this...
Range(Aloc(k)).Offset((RowIns - 4)*k).Select
Click to expand...
 
Upvote 0
Try something like this.

Code: 
[color=darkblue]Sub[/color] testprice2()
    
    [color=darkblue]Dim[/color] SchedA [color=darkblue]As[/color] Worksheet, PPSheet [color=darkblue]As[/color] Worksheet
    [color=darkblue]Dim[/color] rngAloc [color=darkblue]As[/color] Range, AlocCell [color=darkblue]As[/color] Range, k [color=darkblue]As[/color] [color=darkblue]Long[/color], RowIns [color=darkblue]As[/color] [color=darkblue]Long[/color]
    
    Application.DisplayAlerts = [color=darkblue]False[/color]
        [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]Resume[/color] [color=darkblue]Next[/color]
            Sheets("Schedule A").Delete
        [color=darkblue]On[/color] [color=darkblue]Error[/color] [color=darkblue]GoTo[/color] 0
    Application.DisplayAlerts = [color=darkblue]True[/color]
    Sheets("Template").Copy Before:=Sheets(3)
    ActiveSheet.Name = "Schedule A"
    ActiveSheet.Visible = [color=darkblue]True[/color]
    
    [color=darkblue]Set[/color] SchedA = Sheets("Schedule A")
    [color=darkblue]Set[/color] PPSheet = Sheets("Project Pricing Summary")
    PPSheet.Select
    
    [color=green]'Declaration of Avaya H&S no. Location or Service Type in the PP Summary sheet[/color]
    
    [color=green]'The references within this range will automatically change as rows are inserted within this macro[/color]
    [color=darkblue]Set[/color] rngAloc = SchedA.Range("B6, B13, B20, B27, B34, B41, B48, B55, B62, B69")
    
    [color=darkblue]For[/color] [color=darkblue]Each[/color] AlocCell [color=darkblue]In[/color] rngAloc
        k = k + 1
        [color=darkblue]If[/color] PPSheet.Cells(5 + k, 5) <> "" [color=darkblue]Then[/color]
            PPSheet.Cells(5 + k, 1).FormulaR1C1 = _
                "=COUNTIFS('Entry Sheet'!C28,'Entry Sheet'!R1C26&RC[4],'Entry Sheet'!C21,""<>0"")"
            RowIns = PPSheet.Cells(5 + k, 1).Value
            [color=green]'Application.Goto AlocCell.Offset(3, 0)[/color]
            AlocCell.Value = PPSheet.Cells(5 + k, 5).Value
            [color=darkblue]If[/color] RowsIns > 4 [color=darkblue]Then[/color]
                [color=darkblue]With[/color] AlocCell.Offset(3, 0).Resize(RowIns - 4).EntireRow
                    .Insert Shift:=xlDown
                    .RowHeight = 17.25
                [color=darkblue]End[/color] [color=darkblue]With[/color]
            [color=darkblue]End[/color] [color=darkblue]If[/color]
            [color=green]'PPSheet.Select[/color]
        [color=darkblue]Else[/color]
            [color=darkblue]Exit[/color] [color=darkblue]For[/color]
        [color=darkblue]End[/color] [color=darkblue]If[/color]
    [color=darkblue]Next[/color] AlocCell
    
[color=darkblue]End[/color] [color=darkblue]Sub[/color]
 
Upvote 0
Hi Alphafrog,

I really appreciate your "BIG" help on this code. This is what I'm looking for.

Thank you!!!:beerchug:


AlphaFrog said:
Try something like this.

Code: 
[COLOR=darkblue]Sub[/COLOR] testprice2()
    
    [COLOR=darkblue]Dim[/COLOR] SchedA [COLOR=darkblue]As[/COLOR] Worksheet, PPSheet [COLOR=darkblue]As[/COLOR] Worksheet
    [COLOR=darkblue]Dim[/COLOR] rngAloc [COLOR=darkblue]As[/COLOR] Range, AlocCell [COLOR=darkblue]As[/COLOR] Range, k [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR], RowIns [COLOR=darkblue]As[/COLOR] [COLOR=darkblue]Long[/COLOR]
    
    Application.DisplayAlerts = [COLOR=darkblue]False[/COLOR]
        [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]Resume[/COLOR] [COLOR=darkblue]Next[/COLOR]
            Sheets("Schedule A").Delete
        [COLOR=darkblue]On[/COLOR] [COLOR=darkblue]Error[/COLOR] [COLOR=darkblue]GoTo[/COLOR] 0
    Application.DisplayAlerts = [COLOR=darkblue]True[/COLOR]
    Sheets("Template").Copy Before:=Sheets(3)
    ActiveSheet.Name = "Schedule A"
    ActiveSheet.Visible = [COLOR=darkblue]True[/COLOR]
    
    [COLOR=darkblue]Set[/COLOR] SchedA = Sheets("Schedule A")
    [COLOR=darkblue]Set[/COLOR] PPSheet = Sheets("Project Pricing Summary")
    PPSheet.Select
    
    [COLOR=green]'Declaration of Avaya H&S no. Location or Service Type in the PP Summary sheet[/COLOR]
    
    [COLOR=green]'The references within this range will automatically change as rows are inserted within this macro[/COLOR]
    [COLOR=darkblue]Set[/COLOR] rngAloc = SchedA.Range("B6, B13, B20, B27, B34, B41, B48, B55, B62, B69")
    
    [COLOR=darkblue]For[/COLOR] [COLOR=darkblue]Each[/COLOR] AlocCell [COLOR=darkblue]In[/COLOR] rngAloc
        k = k + 1
        [COLOR=darkblue]If[/COLOR] PPSheet.Cells(5 + k, 5) <> "" [COLOR=darkblue]Then[/COLOR]
            PPSheet.Cells(5 + k, 1).FormulaR1C1 = _
                "=COUNTIFS('Entry Sheet'!C28,'Entry Sheet'!R1C26&RC[4],'Entry Sheet'!C21,""<>0"")"
            RowIns = PPSheet.Cells(5 + k, 1).Value
            [COLOR=green]'Application.Goto AlocCell.Offset(3, 0)[/COLOR]
            AlocCell.Value = PPSheet.Cells(5 + k, 5).Value
            [COLOR=darkblue]If[/COLOR] RowsIns > 4 [COLOR=darkblue]Then[/COLOR]
                [COLOR=darkblue]With[/COLOR] AlocCell.Offset(3, 0).Resize(RowIns - 4).EntireRow
                    .Insert Shift:=xlDown
                    .RowHeight = 17.25
                [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]With[/COLOR]
            [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
            [COLOR=green]'PPSheet.Select[/COLOR]
        [COLOR=darkblue]Else[/COLOR]
            [COLOR=darkblue]Exit[/COLOR] [COLOR=darkblue]For[/COLOR]
        [COLOR=darkblue]End[/COLOR] [COLOR=darkblue]If[/COLOR]
    [COLOR=darkblue]Next[/COLOR] AlocCell
    
[COLOR=darkblue]End[/COLOR] [COLOR=darkblue]Sub[/COLOR]
Click to expand...
 
Upvote 0
You must log in or register to reply here.

Similar threads

willow1985
  • Solved
VBA clear contents of multiple ranges.
Replies
5
Views
355
willow1985
willow1985
S
  • Question Question
Create New Sheet with Specific Name Based on Variable Cell
Replies
0
Views
296
SBExcel123
S
E
  • Solved
Can someone tell me why the first column is not displaying all info?
Replies
3
Views
188
RoryA
RoryA
J
  • Solved
IF Statement with twelve conditions for time conditioning
Replies
2
Views
460
Jescanilla
J
imback2nite
  • Solved
VBA help.
2
Replies
10
Views
841
Peter_SSs
Peter_SSs

Share this page

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
Back
Top