VBA Self populate page name in formula

Edwardvanschothorst

New Member
Joined
Sep 20, 2021
Messages
14
Office Version
  1. 365
Platform
  1. Windows
First post here - I have been reading this forum for years, but this time I could not find what I am looking for so I am looking for a little help.

I am working on a worksheet that calculates part costs after I run after I optimize the cut lengths. I am using the 1dcutx add in to optimize my linear stock. (1DCutX - Length Cutting Optimization for Excel)
Once the stock is optimized it adds a range of worksheets starting at 1d_1 - 1d_xx depending on the different amount of layouts required for the job. Each of these sheets needs to have a formula added to distribute the waste length over the number of parts cut out of each length of material, and calculate the part cost based on material length. (part costs comes from my stock worksheet) Once these formula's are added I need to get the totals together in my parts worksheet so I can find the average cost of each part if it comes from various lengths. I have the script worked out to calculate this, but I have to write this code for each page that might exist. Is there a way to set this formula up so that it looks at all pages instead of writing this for each possible page? I could not get the mini uploader to work so I included screenshots of the parts list page, and the code for 1d_2, and 1d_3 below.

Private Sub two()
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "1D_2" Then
Sheets("1D_2").Select
Range("e22") = "=roundup((b$7+2)/count(c$22:c$200)+c22+.055,3)"
Range("F22") = "=(VLOOKUP(A22,STOCK!$A$3:$C$20,3,FALSE)/VLOOKUP(A22,STOCK!$A$3:$C$20,2,FALSE)*E22)"
LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
Range("e22: " & "f" & LastPopulatedRow).FillDown
Sheets("Parts List").Select
Range("f14") = "=SUMPRODUCT(('1D_2'!$B$22:$B$140='Parts List'!$B14)*'1D_2'!$F$22:$F$140)*'1D_2'!$B$2"
LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
Range("f14: " & "f" & LastPopulatedRow).FillDown
MsgBox "1d_2 calculated"
End If
Next i
End Sub

Private Sub three()
For i = 1 To Worksheets.Count
If Worksheets(i).Name = "1D_3" Then
Sheets("1D_3").Select
Range("e22") = "=roundup((b$7+2)/count(c$22:c$200)+c22+.055,3)"
Range("F22") = "=(VLOOKUP(A22,STOCK!$A$3:$C$20,3,FALSE)/VLOOKUP(A22,STOCK!$A$3:$C$20,2,FALSE)*E22)"
LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
Range("e22: " & "f" & LastPopulatedRow).FillDown
Sheets("Parts List").Select
Range("g14") = "=SUMPRODUCT(('1D_3'!$B$22:$B$140='Parts List'!$B14)*'1D_3'!$F$22:$F$140)*'1D_3'!$B$2"
LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
Range("g14: " & "g" & LastPopulatedRow).FillDown
MsgBox "1d_3 calculated"
End If
Next i
End Sub
 

Attachments

  • parts list.PNG
    parts list.PNG
    36.9 KB · Views: 13
  • 1d_2.PNG
    1d_2.PNG
    55.5 KB · Views: 13

Excel Facts

Do you hate GETPIVOTDATA?
Prevent GETPIVOTDATA. Select inside a PivotTable. In the Analyze tab of the ribbon, open the dropown next to Options and turn it off
VBA Code:
Private Sub AllSheets()
For i = 1 To Worksheets.Count
CurSheetName = Sheets(i).Name
Sheets(CurSheetName).Select
Range("e22") = "=roundup((b$7+2)/count(c$22:c$200)+c22+.055,3)"
Range("F22") = "=(VLOOKUP(A22,STOCK!$A$3:$C$20,3,FALSE)/VLOOKUP(A22,STOCK!$A$3:$C$20,2,FALSE)*E22)"
LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
Range("e22: " & "f" & LastPopulatedRow).FillDown
Sheets("Parts List").Select
Range("f14") = "=SUMPRODUCT(('CurSheetName'!$B$22:$B$140='Parts List'!$B14)*'CurSheetName'!$F$22:$F$140)*'CurSheetName'!$B$2"
LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
Range("f14: " & "f" & LastPopulatedRow).FillDown
MsgBox CurSheetName & " calculated"
End If
Next i
End Sub
 
Last edited:
Upvote 0
Actually I think you would have to fix:
VBA Code:
Range("f14") = "=SUMPRODUCT(('CurSheetName'!$B$22:$B$140='Parts List'!$B14)*'CurSheetName'!$F$22:$F$140)*'CurSheetName'!$B$2"

to:
VBA Code:
Range("f14") = "=SUMPRODUCT(('" & CurSheetName & "'!$B$22:$B$140='Parts List'!$B14)*'" & CurSheetName & "'!$F$22:$F$140)*'" & CurSheetName & "'!$B$2"
 
Upvote 0
Johnny
This is right along the lines that I am looking for, thank you for taking the time.
This code will assume that the calculation will need to be made on all pages, however there are 8 pages that do not need the calculation. only the pages that start with 1d_ will need the calculations made. Is there a way to isolate those pages? These will always be the last pages in the workbook, but there will always be a different number of pages. In my original workbook I was working with 1D_1 - 1d_9, as per the screenshot attached it shows pages up to 1d_11, but it goes up to 1d_23
 

Attachments

  • Pages.PNG
    Pages.PNG
    6.5 KB · Views: 9
Upvote 0
Something like this? I believe JohnnyL forgot this line as there is an "End If" at the end without an If statement.

VBA Code:
Private Sub AllSheets()

For i = 1 To Worksheets.Count
  CurSheetName = Sheets(i).Name
  If UCase(Left(CurSheetName,3))="1D_" Then  ' Added line to check if name starts with "1d_"
    Sheets(CurSheetName).Select
    Range("e22") = "=roundup((b$7+2)/count(c$22:c$200)+c22+.055,3)"
    Range("F22") = "=(VLOOKUP(A22,STOCK!$A$3:$C$20,3,FALSE)/VLOOKUP(A22,STOCK!$A$3:$C$20,2,FALSE)*E22)"
    LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("e22: " & "f" & LastPopulatedRow).FillDown
    Sheets("Parts List").Select
    Range("f14") = "=SUMPRODUCT(('CurSheetName'!$B$22:$B$140='Parts List'!$B14)*'CurSheetName'!$F$22:$F$140)*'CurSheetName'!$B$2"
    LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
    Range("f14: " & "f" & LastPopulatedRow).FillDown
    MsgBox CurSheetName & " calculated"
  End If
Next i

End Sub
 
Upvote 0
Hopefully this will work as you want:

VBA Code:
Private Sub AllSheetsV2()
'
    For i = 1 To Worksheets.Count
        CurSheetName = Sheets(i).Name
        Sheets(CurSheetName).Select
'
        If Left(CurSheetName, 3) = "1D_" And IsNumeric(Mid(CurSheetName, 4, 1)) Then
            Range("e22") = "=roundup((b$7+2)/count(c$22:c$200)+c22+.055,3)"
            Range("F22") = "=(VLOOKUP(A22,STOCK!$A$3:$C$20,3,FALSE)/VLOOKUP(A22,STOCK!$A$3:$C$20,2,FALSE)*E22)"
            LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
            Range("e22: " & "f" & LastPopulatedRow).FillDown
            Sheets("Parts List").Select
            Range("f14") = "=SUMPRODUCT(('" & CurSheetName & "'!$B$22:$B$140='Parts List'!$B14)*'" & CurSheetName & "'!$F$22:$F$140)*'" & CurSheetName & "'!$B$2"
            LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
            Range("f14: " & "f" & LastPopulatedRow).FillDown
            MsgBox CurSheetName & " calculated"
        End If
    Next i
End Sub
 
Upvote 0
This resolves the page issue for the first section of the process. Once sheets("parts list") is selected this will output the Parts list page name in the Range.F14 formula, where we still need to grab the 1d_x page name that it was on last. Another couple of issues I just noticed:
1. The fill down function clears cells E22 and F22 if there is only one row of data on the page - noted below
2. The F14 value needs to bump a column every time it cycles through and finds another 1d_page. If I have 1d_1 - 1d_9 I should be going from column E14:L21

Private Sub AllSheets()

For i = 1 To Worksheets.Count
CurSheetName = Sheets(i).Name
If UCase(Left(CurSheetName,3))="1D_" Then ' Added line to check if name starts with "1d_"
Sheets(CurSheetName).Select
Range("e22") = "=roundup((b$7+2)/count(c$22:c$200)+c22+.055,3)"
Range("F22") = "=(VLOOKUP(A22,STOCK!$A$3:$C$20,3,FALSE)/VLOOKUP(A22,STOCK!$A$3:$C$20,2,FALSE)*E22)"
LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
"fill down will clear cell E22 and F22
Range("e22: " & "f" & LastPopulatedRow).FillDown
Sheets("Parts List").Select
'this will grab the parts list page, but it needs to grab the 1d_ x page that it just populated the cells on
Range("f14") = "=SUMPRODUCT(('CurSheetName'!$B$22:$B$140='Parts List'!$B14)*'CurSheetName'!$F$22:$F$140)*'CurSheetName'!$B$2"
LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
Range("f14: " & "f" & LastPopulatedRow).FillDown
MsgBox CurSheetName & " calculated"
End If
Next i

End Sub
 

Attachments

  • Fill down error.PNG
    Fill down error.PNG
    23.9 KB · Views: 8
Upvote 0
Apologies, I missed the range increments in the lower portion of the code.

VBA Code:
Private Sub AllSheetsV3()
'
    ColumnIncrementer = -1
'
    For i = 1 To Worksheets.Count
        CurSheetName = Sheets(i).Name
        Sheets(CurSheetName).Select
'
        If Left(CurSheetName, 3) = "1D_" And IsNumeric(Mid(CurSheetName, 4, 1)) Then
            ColumnIncrementer = ColumnIncrementer + 1
'
            Range("e22") = "=roundup((b$7+2)/count(c$22:c$200)+c22+.055,3)"
            Range("F22") = "=(VLOOKUP(A22,STOCK!$A$3:$C$20,3,FALSE)/VLOOKUP(A22,STOCK!$A$3:$C$20,2,FALSE)*E22)"
            LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
            Range("e22: " & "f" & LastPopulatedRow).FillDown
            Sheets("Parts List").Select
'
            Cells(14, 6 + ColumnIncrementer) = "=SUMPRODUCT(('" & CurSheetName & "'!$B$22:$B$140='Parts List'!$B14)*'" & CurSheetName & "'!$F$22:$F$140)*'" & CurSheetName & "'!$B$2"
'
            LastPopulatedRow = Range("A" & Rows.Count).End(xlUp).Row
'
            Range(Cells(14, 6 + ColumnIncrementer), Cells(LastPopulatedRow, 6 + ColumnIncrementer)).FillDown
'
            MsgBox CurSheetName & " calculated"
        End If
    Next i
End Sub
 
Upvote 0
No worries, when I get this working it will be worth the headache.
I finally had a chance to try and run this, and I get an error on sheets(cursheetName).select - run time 1004 select method of worksheet class failed.
 
Upvote 0
I hate to say impossible, but the code I posted should not error at that point.

Maybe try a reboot of computer and try it again.
 
Upvote 0

Forum statistics

Threads
1,214,950
Messages
6,122,436
Members
449,083
Latest member
Ava19

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