Counter in For Each loop

P

Possum17

New Member
Joined
Mar 4, 2024
Messages
3
Office Version
  1. 365
Platform
  1. Windows
I created a file which will calculate sales rep commission based on terms and conditions of the commission agreement. All sales rep performance data is filled in on one tab, and then through selections on drop down boxes, the file will generate the correct payout to be paid to relevant sales reps.

The file functions correctly for manually doing one rep at a time. This is very time consuming and seems like something that could be automated in vba. I post the macro I have written below. I *think* this functions correctly in all aspects except it always pastes values to outputs in AH/AI/AJ/AK6. Each line is unique to a sales rep, so I think I need a counter in my For Each loop which will bump the paste target cells down one line after each AH/AI/AJ/AK set. I am having trouble getting this part of the code to work. I tried to insert a For To counter within the code in various spots but I couldn't get it to work.

Any input appreciated!

ps. if it wasn't obvious enough already, I am very new to writing my own VBA :)

VBA Code: 
Sub ForEachRepEnhanced()
'
' ForEachRep Macro
' Loops each rep
'

'
    Dim Cell As Range
    
    For Each Cell In Sheets("1.Information from Target Sheet").Range("B6:B31")
            Sheets("Rep Select").Range("D3").Value = Cell.Value
            Sheets("3. Payout").Select
            Range("D9:H11").Select
            Selection.ClearContents
            Sheets("2. Sales data").Select
            Range("D3").Value = 1
            Sheets("3. Payout").Select
            Range("D21").Select
            Selection.Copy
            Sheets("Rep data").Select
            Range("AH6").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                   :=False, Transpose:=False
            Sheets("3. Payout").Select
            Range("D17:H17").Select
            Application.CutCopyMode = False
            Selection.Copy
            Range("D9").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("2. Sales data").Select
            Range("D3").Value = 2
            Sheets("3. Payout").Select
            Range("D21").Select
            Selection.Copy
            Sheets("Rep data").Select
            Range("AI6").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("3. Payout").Select
            Range("D17:H17").Select
            Application.CutCopyMode = False
            Selection.Copy
            Range("D10").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("2. Sales data").Select
            Range("D3").Value = 3
            Sheets("3. Payout").Select
            Range("D21").Select
            Selection.Copy
            Sheets("Rep data").Select
            Range("AJ6").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("3. Payout").Select
            Range("D17:H17").Select
            Application.CutCopyMode = False
            Selection.Copy
            Range("D11").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("2. Sales data").Select
            Range("D3").Value = 4
            Application.CutCopyMode = False
            Range("D4").Select
            Sheets("3. Payout").Select
            Range("D21").Select
            Selection.Copy
            Sheets("Rep data").Select
            Range("AK6").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("3. Payout").Select
            Range("D9:H11").Select
            Application.CutCopyMode = False
            Selection.ClearContents
    Next Cell
End Sub
 

Excel Facts

How can you automate Excel?
Press Alt+F11 from Windows Excel to open the Visual Basic for Applications (VBA) editor.
Sort by date Sort by votes
Stepping through, I also think this part is not working. I want this to update a cell based on the cell reference in the loop, but that doesn't seem to work.

VBA Code: 
Sheets("Rep Select").Range("D3").Value = Cell.Value
 
Upvote 0
Think I figured it out. This is what I ended up with. Seems to work.

VBA Code: 
Sub ForEachRepEnhanced()
'
' ForEachRep Macro
' Loops each rep
'

'
    
    For Each Rng In Sheets("Rep data").Range("B6:B31")
            Range("A1").Value = Rng.Value
            Sheets("3. Payout").Select
            Range("D9:H11").Select
            Selection.ClearContents
            Sheets("2. Sales data").Select
            Range("D3").Value = 1
            Sheets("3. Payout").Select
            Range("D21").Select
            Selection.Copy
            Sheets("Rep data").Select
            Rng.Offset(0, 32).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                   :=False, Transpose:=False
            Sheets("3. Payout").Select
            Range("D17:H17").Select
            Application.CutCopyMode = False
            Selection.Copy
            Range("D9").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("2. Sales data").Select
            Range("D3").Value = 2
            Sheets("3. Payout").Select
            Range("D21").Select
            Selection.Copy
            Sheets("Rep data").Select
            Rng.Offset(0, 33).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("3. Payout").Select
            Range("D17:H17").Select
            Application.CutCopyMode = False
            Selection.Copy
            Range("D10").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("2. Sales data").Select
            Range("D3").Value = 3
            Sheets("3. Payout").Select
            Range("D21").Select
            Selection.Copy
            Sheets("Rep data").Select
            Rng.Offset(0, 34).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("3. Payout").Select
            Range("D17:H17").Select
            Application.CutCopyMode = False
            Selection.Copy
            Range("D11").Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("2. Sales data").Select
            Range("D3").Value = 4
            Application.CutCopyMode = False
            Range("D4").Select
            Sheets("3. Payout").Select
            Range("D21").Select
            Selection.Copy
            Sheets("Rep data").Select
            Rng.Offset(0, 35).Select
            Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                :=False, Transpose:=False
            Sheets("3. Payout").Select
            Range("D9:H11").Select
            Application.CutCopyMode = False
            Selection.ClearContents
            Sheets("Rep Data").Select
            Range("A1").Select
            Selection.ClearContents
            ClearClipboard
    Next Rng
End Sub
 
Upvote 0
Solution
You must log in or register to reply here.

Similar threads

C
  • Question
Please help clean up my convoluted VBA code. It seems very redundant and repetitive.
Replies
1
Views
137
myall_blues
myall_blues
C
  • Solved
Please help me clean up my VBA script, I'm having trouble with redundancies
Replies
4
Views
156
CapRavOr
C
A
  • Question
Macro to update list to last row on another sheet copy source from multiple sheets
Replies
0
Views
347
Azamamir
A
P
  • Solved
Need help with macro Dynamic Range??
Replies
6
Views
263
pennbowl
P
willow1985
  • Solved
Find first blank cell in column A in a Table - Runtime error 91
Replies
4
Views
185
willow1985
willow1985

Forum statistics

Threads
1,216,500
Messages
6,131,015
Members
449,615
Latest member
Nic0la

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