Loop works on 1st cell in range but then stops...any suggestions?

EVANWIT84

New Member
Joined
Sep 25, 2020
Messages
22
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
  3. Mobile
Hi All,

I am trying to loop thru each account in my account master, find the range of cells 7 rows over in the next tab, copy those cells into a calculation sheet with a multiple the values, then I want to paste the end result back into my account master sheet. I am able to get the 1st account to work in my list but then it stops after the 1st account and doesn't calculate any further. I'm thinking I need an outer loop where I state For Each Cell in AcctRng then let it loop thru the find, multiply, then copy and write a Next after. Any thoughts?

Sub FindAcctReturn()

'1. Store Accounts as Variable

Dim AcctNum As Long
Dim AcctRng As Range
Dim Cell As Range
Dim CompId As Range
Dim i As Byte
Dim FirstMatch As Variant
Dim CalcSheet As Worksheet
Dim h As Long
Dim lstCell As Long

Set CalcSheet = Sheet9
Set AcctRng = Sheet2.Range("A2:A1000")
Sheets("CalcSheet").Range("a1:i1000").ClearContents 'Clears Content in Calc Sheet Destination
'2 Lookup Accounts in Master Table

i = 3

Set CompId = Sheet1.Range("A:I").Find(AcctRng, LookIn:=xlValues, lookat:=xlWhole)

If Not CompId Is Nothing Then
Sheets("CalcSheet").Range("B" & i).Value = CompId.Offset(, 7).Value
FirstMatch = CompId.Address
Do
Set CompId = Sheet1.Range("A:A").FindNext(CompId)
If CompId.Address = FirstMatch Then Exit Do
i = i + 1
Sheets("CalcSheet").Range("B" & i).Value = CompId.Offset(, 7).Value

Loop
End If


'3 Perform Calc of cumulative returns in CalcSheet by acct

lstCell = CalcSheet.Range("b1048567").End(xlUp).Row

For h = 2 To lstCell
If h = lstCell Then Exit Sub
CalcSheet.Cells(h, "c") = 1 + CalcSheet.Cells(h, "B")
CalcSheet.Range("C1").Value = "=PRODUCT(R[1]C:R[999]C)-1"
Sheet2.Range("D2").Value = CalcSheet.Range("C1").Value '4 Paste Data from Variable into Account Master Tab
Next

End Sub
 

Excel Facts

Pivot Table Drill Down
Double-click any number in a pivot table to create a new report showing all detail rows that make up that number
Perhaps something like that.
VBA Code:
Sub FindAcctReturn()

'1. Store Accounts as Variable

    Dim AcctNum As Long
    Dim AcctRng As Range
    Dim Cel As Range
    Dim CompId As Range
    Dim i As Byte
    Dim FirstMatch As Variant
    Dim CalcSheet As Worksheet
    Dim h As Long
    Dim lstCell As Long
    
    Set CalcSheet = Sheet9
    Set AcctRng = Sheet2.Range("A2:A1000")
    Sheets("CalcSheet").Range("a1:i1000").ClearContents 'Clears Content in Calc Sheet Destination
    '2 Lookup Accounts in Master Table
    
    i = 3
    For Each Cel In AcctRng
        Set CompId = Sheet1.Range("A:I").Find(Cel.Value, LookIn:=xlValues, lookat:=xlWhole)
        
        If Not CompId Is Nothing Then
            Sheets("CalcSheet").Range("B" & i).Value = CompId.Offset(, 7).Value
            FirstMatch = CompId.Address
            Do
                Set CompId = Sheet1.Range("A:A").FindNext(CompId)
                If CompId.Address = FirstMatch Then Exit Do
                i = i + 1
                Sheets("CalcSheet").Range("B" & i).Value = CompId.Offset(, 7).Value
            Loop
        End If
    Next
    
    '3 Perform Calc of cumulative returns in CalcSheet by acct
    
    lstCell = CalcSheet.Range("b1048567").End(xlUp).Row
    
    For h = 2 To lstCell
        If h = lstCell Then Exit Sub
        CalcSheet.Cells(h, "c") = 1 + CalcSheet.Cells(h, "B")
        CalcSheet.Range("C1").Value = "=PRODUCT(R[1]C:R[999]C)-1"
        Sheet2.Range("D2").Value = CalcSheet.Range("C1").Value '4 Paste Data from Variable into Account Master Tab
    Next

End Sub
 
Upvote 0
Hi maras,

Thanks for the assistance. It looks like my code makes it thru the first 172 rows of data then hits the Debug on i = i + 1. Overflow (Error 6).

As a result, I changed i from Byte to Long. Now, it looks like it copies all 70k rows from the one tab to the next when you suggest using the For Each Loop and then closing it after the End If statement. My order of operations needs to change somewhat. I need to only copy the data for 1 account at a time to the calc. sheet tab, calculate the total return, paste it, then begin the loop again. Let me see if I can close the loop later on and perhaps that may work. I will circle back.

Thanks,
Evan
 
Upvote 0
Hi maras,

Thanks for the assistance. It looks like my code makes it thru the first 172 rows of data then hits the Debug on i = i + 1. Overflow (Error 6).

As a result, I changed i from Byte to Long. Now, it looks like it copies all 70k rows from the one tab to the next when you suggest using the For Each Loop and then closing it after the End If statement. My order of operations needs to change somewhat. I need to only copy the data for 1 account at a time to the calc. sheet tab, calculate the total return, paste it, then begin the loop again. Let me see if I can close the loop later on and perhaps that may work. I will circle back.

Thanks,
Evan
I tried nesting the loop outside to no avail. Open to any other suggestions.


Sub FindAcctReturnv3()

'1. Store Accounts as Variable

Dim AcctNum As Long
Dim AcctRng As Range
Dim Cel As Range
Dim CompId As Range
Dim i As Long
Dim FirstMatch As Variant
Dim CalcSheet As Worksheet
Dim h As Long
Dim lstCell As Long

Set CalcSheet = Sheet9
Set AcctRng = Sheet2.Range("A2:A1000")
Sheets("CalcSheet").Range("a1:i1000").ClearContents 'Clears Content in Calc Sheet Destination
'2 Lookup Accounts in Master Table
lstCell = CalcSheet.Range("b1048567").End(xlUp).Row
i = 3

For Each Cel In AcctRng
Set CompId = Sheet1.Range("A:I").Find(Cel.Value, LookIn:=xlValues, lookat:=xlWhole)

If Not CompId Is Nothing Then
Sheets("CalcSheet").Range("B" & i).Value = CompId.Offset(, 7).Value
FirstMatch = CompId.Address
Do
Set CompId = Sheet1.Range("A:A").FindNext(CompId)
If CompId.Address = FirstMatch Then Exit Do
i = i + 1
Sheets("CalcSheet").Range("B" & i).Value = CompId.Offset(, 7).Value
Loop
For h = 2 To lstCell
CalcSheet.Cells(h, "c") = 1 + CalcSheet.Cells(h, "B")
CalcSheet.Range("C1").Value = "=PRODUCT(R[1]C:R[999]C)-1"
Sheet2.Range("D2").Value = CalcSheet.Range("C1").Value '4 Paste Data from Variable into Account Master Tab
Next

End If

Sheet2.Range("D2").Value = Sheet2.Range("D2").Offset(1, 0)

Next


End Sub
 
Upvote 0
You might consider providing a sample of the four, perhaps five, worksheets involved.
Use XL2BB for that and explain clearly what exactly you expect from the code.

Finally, please paste your code between code tags:
ScreenShot006.png
 
Upvote 0
Hi All,

I am trying to loop thru each account in my account master, find the range of cells 7 rows over in the next tab, copy those cells into a calculation sheet with a multiple the values, then I want to paste the end result back into my account master sheet. I am able to get the 1st account to work in my list but then it stops after the 1st account and doesn't calculate any further. I'm thinking I need an outer loop where I state For Each Cell in AcctRng then let it loop thru the find, multiply, then copy and write a Next after. Any thoughts?

Sub FindAcctReturn()

'1. Store Accounts as Variable

Dim AcctNum As Long
Dim AcctRng As Range
Dim Cell As Range
Dim CompId As Range
Dim i As Byte
Dim FirstMatch As Variant
Dim CalcSheet As Worksheet
Dim h As Long
Dim lstCell As Long

Set CalcSheet = Sheet9
Set AcctRng = Sheet2.Range("A2:A1000")
Sheets("CalcSheet").Range("a1:i1000").ClearContents 'Clears Content in Calc Sheet Destination
'2 Lookup Accounts in Master Table

i = 3

Set CompId = Sheet1.Range("A:I").Find(AcctRng, LookIn:=xlValues, lookat:=xlWhole)

If Not CompId Is Nothing Then
Sheets("CalcSheet").Range("B" & i).Value = CompId.Offset(, 7).Value
FirstMatch = CompId.Address
Do
Set CompId = Sheet1.Range("A:A").FindNext(CompId)
If CompId.Address = FirstMatch Then Exit Do
i = i + 1
Sheets("CalcSheet").Range("B" & i).Value = CompId.Offset(, 7).Value

Loop
End If


'3 Perform Calc of cumulative returns in CalcSheet by acct

lstCell = CalcSheet.Range("b1048567").End(xlUp).Row

For h = 2 To lstCell
If h = lstCell Then Exit Sub
CalcSheet.Cells(h, "c") = 1 + CalcSheet.Cells(h, "B")
CalcSheet.Range("C1").Value = "=PRODUCT(R[1]C:R[999]C)-1"
Sheet2.Range("D2").Value = CalcSheet.Range("C1").Value '4 Paste Data from Variable into Account Master Tab
Next

End Sub

Here's the 1st tab of the account master:

Client Account NumberClient Master Account NameClent Account NameCumulative Return
1​
EvEv
2​
RR
3​
DonaldDonald
4​
BidenBiden

Here's the 2nd tab with the data:
Client Account NumberClient Master Account NameClent Account NamePeriodContributionWithdrawalEnding Market ValueNet Return
1​
1​
0.0181​
1​
1​
0.031​
1​
1​
0.0313​
1​
1​
0.0555​
1​
1​
0.0435​
1​
1​
-0.0082​
1​
1​
-0.0156​
1​
1​
0.176​
1​
1​
0.0613​
1​
1​
0.0222​
1​
1​
0.0686​
1​
1​
0.0747​
1​
1​
0.0572​
1​
1​
0.0775​
1​
1​
0.0822​
1​
1​
0.061​
1​
1​
0.0904​
1​
1​
0.0381​
1​
1​
0.0867​
1​
1​
0.0511​
1​
1​
0.0236​
1​
1​
0.0754​
1​
1​
0.1482​
1​
1​
0.1957​
1​
1​
0.1322​
1​
1​
0.1819​
1​
1​
0.2059​
1​
1​
0.1299​
1​
1​
0.1424​
1​
1​
0.108​
1​
1​
0.2096​
1​
1​
0.1413​
1​
1​
0.1998​
1​
1​
0.2443​
1​
1​
0.2​
1​
1​
0.2566​
1​
1​
0.268​
1​
1​
0.1355​
1​
1​
0.2564​
1​
1​
0.1389​
1​
1​
0.202​
1​
1​
0.1101​
1​
1​
0.1462​
1​
1​
0.1546​
1​
1​
0.1705​
1​
1​
0.0463​
1​
1​
0.0834​
1​
1​
0.0427​
1​
1​
0.0247​
1​
1​
0.0024​
1​
1​
-0.0108​
2​
1​
0.0147​
3​
1​
-0.3733​
 
Upvote 0
Good point. I will try to be clear but apologies if it doesn't make sense. Long story short is that the code does not perform the routine over and over across all accounts.

Variables & Objects

Dim AcctNum As Long
Dim AcctRng As Range
Dim Cel As Range
Dim CompId As Range
Dim i As Long
Dim FirstMatch As Variant
Dim CalcSheet As Worksheet
Dim h As Long
Dim lstCell As Long

Set CalcSheet = Sheet9
Set AcctRng = Sheet2.Range("A2:A1000")
Sheets("CalcSheet").Range("a1:i1000").ClearContents 'Clears Content in Calc Sheet Destination


'’’’’’’ I want to Lookup Accounts in Master Table.’’’’’’’’’’’’’’’’’’
lstCell = CalcSheet.Range("b1048567").End(xlUp).Row
i = 3

Client Account NumberClient Master Account NameClent Account NameCumulative Return
1EvEv
2RR
3DonaldDonald
4BidenBiden



‘’’’’’’On the next 9 lines here I am looking up the accounts and finding in the Raw Data table. I am then taking the raw data, 7 columns over and pasting into the Calc.Sheet. This code is working as expected.’’’’’’’

Set CompId = Sheet1.Range("A:I").Find(AcctRng, LookIn:=xlValues, lookat:=xlWhole)

If Not CompId Is Nothing Then
Sheets("CalcSheet").Range("B" & i).Value = CompId.Offset(, 7).Value
FirstMatch = CompId.Address
Do
Set CompId = Sheet1.Range("A:A").FindNext(CompId)
If CompId.Address = FirstMatch Then Exit Do
i = i + 1
Sheets("CalcSheet").Range("B" & i).Value = CompId.Offset(, 7).Value

Loop
End If
Here's the 2nd tab with the data:
Client Account NumberClient Master Account NameClent Account NamePeriodContributionWithdrawalEnding Market ValueNet Return
110.0181
110.031
110.0313
110.0555


‘’’’’’’’’'3 Perform Calc of cumulative returns in CalcSheet by acct. This codes works and calculates the product of the results from the prior code. This is just a blank worksheet.

lstCell = CalcSheet.Range("b1048567").End(xlUp).Row

For h = 2 To lstCell
If h = lstCell Then Exit Sub
CalcSheet.Cells(h, "c") = 1 + CalcSheet.Cells(h, "B")
CalcSheet.Range("C1").Value = "=PRODUCT(R[1]C:R[999]C)-1"
Sheet2.Range("D2").Value = CalcSheet.Range("C1").Value '4 Paste Data from Variable into Account Master Tab
Next
‘’’’’’’’’’’’At this point I would like the routine to start back over and loop thru again to calculate. But it stops here.
End Sub
 
Upvote 0
It's hard to understand your problem.
Maybe that's it.
1st tab (final) is on sheet 2 and tab 2 (with data) on sheet 1.
Run the code and check.
VBA Code:
Sub maras()
    Dim a(), af
    Dim i As Long, r As Long
    
    With Sheets("Sheet1")
        a = .[A1].CurrentRegion.Value
        ReDim af(1 To UBound(a), 1 To 4)
        
        For i = 2 To UBound(a)
            If a(i, 1) <> a(i - 1, 1) Then
                r = r + 1
                af(r, 1) = a(i, 1)
                af(r, 2) = a(i, 2)
                af(r, 3) = a(i, 3)
            End If
            af(r, 4) = af(r, 4) + a(i, 8)
        Next
    End With
    
    With Sheets("Sheet2")
        .UsedRange.ClearContents
        With .[A1]
            .Resize(, 4) = [{"Client Account Number","Client Master Account Name", "Client Account Name","Cumulative Return"}]
            .Offset(1).Resize(r, UBound(af, 2)) = af
        End With
    End With
End Sub
 
Upvote 0
Solution

Forum statistics

Threads
1,223,236
Messages
6,170,912
Members
452,366
Latest member
TePunaBloke

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