Find value via loop in another worksheet and change it

wtom0412

Board Regular
Joined
Jan 3, 2015
Messages
168
Good Morning All,

My worksheet calculates Sales Margins based on a formula (recipe) for 134 Product (and other costs: labour, other materials etc).

I have two sheets, Margin Calculator (MC) and Formulas. Formulas (as the name suggests) contains all of the various formulas for our products, and MC does the calculations.

Once I select a product on MC, data gets pulled from Formulas via a VLOOKUP.

The data consists of Ingredient Name and % of ingredient used. There can be up to 28 ingredients depending on what product is selected. This data appears in MC in P3:P30 and Q3:Q30.
There is a unique Helper Cell on MC (O3:O30) that exists on Formulas (C:C) to help with the look up.

When I am looking at Sales Margins, I want to be able to play with the % of Ingredient used to achieve the best Margin possible.

So, I want to type a value into a cells M3:M30 in Margin Calculator, and once I am happy with the amendments, click a button and have VBA change the corresponding values in Formulas.

I found some code on the net, and it works on the first value, but I can't figure out how to loop through both MC M3:M30 and Formuls C:C to effect the next value.

VBA Code:
Sub Change_Percentage()

FindItem = Sheets("Margin Calculator").Range("O3").Value

On Error Resume Next
FoundItem = Sheets("Formulas").Range("C2:C65535").Find(What:=FindItem).Address
On Error GoTo 0

If FoundItem <> "" Then
    PasteLocation = Sheets("Formulas").Range(FoundItem).Offset(0, 2).Address

    Sheets("Margin Calculator").Range("M3").Copy Sheets("Formulas").Range(PasteLocation)
    
Else
    MsgBox ("Item not found. No action performed.")
End If

End Sub

I am so sorry if this message is confusing, and any help would be greatly appreciated.

Cheers, Toby
 

Some videos you may like

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.

Puertorekinsam

Active Member
Joined
Oct 8, 2005
Messages
287
You will need a loop for 3-30
then you will need to change your offset from (0,2) to the loop (i) variable minus 1 (since it starts with 3)
and then instead of range ("M3") you use a cell reference. "M" is the 13th column, and then you use your loop variable for the row variable. Cells(13,i)


VBA Code:
Sub Change_Percentage()

FindItem = Sheets("Margin Calculator").Range("O3").Value

On Error Resume Next
FoundItem = Sheets("Formulas").Range("C2:C65535").Find(What:=FindItem).Address
On Error GoTo 0

If FoundItem <> "" Then
    for i = 3 to 30
        PasteLocation = Sheets("Formulas").Range(FoundItem).Offset(0, i-1).Address

        Sheets("Margin Calculator").cells(13,i).Copy Sheets("Formulas").Range(PasteLocation)
    next
Else
    MsgBox ("Item not found. No action performed.")
End If

End Sub
 

Puertorekinsam

Active Member
Joined
Oct 8, 2005
Messages
287
Sorry... I did the cell reference backwards. The row is first, the column is second.

VBA Code:
Sub Change_Percentage()

FindItem = Sheets("Margin Calculator").Range("O3").Value

On Error Resume Next
FoundItem = Sheets("Formulas").Range("C2:C65535").Find(What:=FindItem).Address
On Error GoTo 0

If FoundItem <> "" Then
    for i = 3 to 30
        PasteLocation = Sheets("Formulas").Range(FoundItem).Offset(0, i-1).Address

        Sheets("Margin Calculator").cells(i,13).Copy Sheets("Formulas").Range(PasteLocation)
    next
Else
    MsgBox ("Item not found. No action performed.")
End If

End Sub
 

wtom0412

Board Regular
Joined
Jan 3, 2015
Messages
168

ADVERTISEMENT

Hi Puertorekinsam,

Thank you so much for helping me. The loop is working perfectly, except it pastes the value along the row in Formulas, rather than down Column E.

The first time through the loop works and places the correct value in E2, but the second time through it places it in F2 then G2 etc.

I am assuming it has something to do with the line...

VBA Code:
PasteLocation = Sheets("Formulas").Range(FoundItem).Offset(0, i - 1).Address

specifically the offset part, but despite changing these values, I cant get it to go down the column?

Cheers, Toby
 

Puertorekinsam

Active Member
Joined
Oct 8, 2005
Messages
287
okay, so you want to find the formula in column C, and then starting with that row, in column e go down one row at a time?
this should do that

VBA Code:
Sub Change_Percentage()

FindItem = Sheets("Margin Calculator").Range("O3").Value

On Error Resume Next
FoundItem = Sheets("Formulas").Range("C2:C65535").Find(What:=FindItem).Address
On Error GoTo 0

If FoundItem <> "" Then
    For i = 3 To 30
        PasteLocation = Sheets("Formulas").Range(FoundItem).Offset(i - 3, 2).Address

        Sheets("Margin Calculator").Cells(i, 13).Copy Sheets("Formulas").Range(PasteLocation)
    Next
Else
    MsgBox ("Item not found. No action performed.")
End If

End Sub
 

wtom0412

Board Regular
Joined
Jan 3, 2015
Messages
168

ADVERTISEMENT

Hi Puertorekinsam,

It is now correctly pasting down the Column correctly, but it doesn't stop when it it runs out of matching cells.

I'll try to explain.

Column O on the Margin Calculator is a Unique tag that identifies the row for the product called Essential Oil Blend - there are only six ingredients in the Product. Column Q is what comes (via a VLOOKUP) from the Formulas sheet, Column M is what I manually enter to test the Margins.

M​
O​
P​
Q​
HELPER CELLS (HIDDEN)
Use (21.00%)​
Extension​
Ingredient​
Use (21.00%)​
1.00%1Essential Oil BlendBergamot Oil* (Bergaptene-Free)21.000%
2.00%2Essential Oil BlendCedarwood Atlas Oil*22.000%
3.00%3Essential Oil BlendCinnamon Essential Oil*23.000%
4.00%4Essential Oil BlendGinger Root Oil*24.000%
5.00%5Essential Oil BlendOrange (Sweet) Oil*25.000%
6.00%6Essential Oil BlendPatchouli Oil*26.000%
7Essential Oil Blend
8Essential Oil Blend
9Essential Oil Blend

Column C on the Formulas tab matches Column O on the Margin Calculator tab.

C​
D​
E​
Helper Cell (Hidden)​
Ingredient Name​
% of ingredient in finished product​
1Essential Oil BlendBergamot Oil* (Bergaptene-Free)21.00%
2Essential Oil BlendCedarwood Atlas Oil*22.00%
3Essential Oil BlendCinnamon Essential Oil*23.00%
4Essential Oil BlendGinger Root Oil*24.00%
5Essential Oil BlendOrange (Sweet) Oil*25.00%
6Essential Oil BlendPatchouli Oil*26.00%
1Release BalmArnica Extract*10.00%
2Release BalmCarnauba Wax*11.00%
3Release BalmCastor Oil*12.00%

I need the macro to stop when it encounters the first blank in Column M of the Margin Calculator or until it no longer finds a match in Column C of the Formulas sheet.

I am sorry if that wasn't clear in my original post, but I though the following code would stop it?

VBA Code:
If FoundItem <> "" Then
 

Puertorekinsam

Active Member
Joined
Oct 8, 2005
Messages
287
Now that is a horse of a different color... try this:

VBA Code:
Sub Change_Percentage()

i = 3
FoundItem = "PlaceHolder"
Do Until Sheets("Margin Calculator").Cells(i, 13) = "" Or FoundItem = ""


    FindItem = Sheets("Margin Calculator").Cells(i, 15).Value

    FoundItem = Sheets("Formulas").Columns(3).Find(What:=FindItem).Address


If FindItem <> "" And FoundItem <> "" Then

    Sheets("Margin Calculator").Cells(i, 13).Copy Sheets("Formulas").Range(Sheets("Formulas").Range(FoundItem).Offset(0, 2).Address)

Else
    MsgBox ("Item not found. No action performed.")
End If

    i = i + 1
Loop

End Sub
 

wtom0412

Board Regular
Joined
Jan 3, 2015
Messages
168
Thank you Puertorekinsam,

The first time through the loop works perfectly, but then I get a "Runtime error 91: Object Variable or With block variable not set" after

VBA Code:
    FoundItem = Sheets("Formulas").Columns(3).Find(What:=FindItem).Address

on the second loop?

Cheers, Toby
 

Puertorekinsam

Active Member
Joined
Oct 8, 2005
Messages
287
also updated the code so it shows you "what" wasn't found

VBA Code:
Sub Change_Percentage()

i = 3
Founditem = "PlaceHolder"
Do Until Sheets("Margin Calculator").Cells(i, 13) = "" Or Founditem = ""


    Finditem = Sheets("Margin Calculator").Cells(i, 15).Value
        x = Application.CountIfs(Sheets("Formulas").Columns(3), Finditem)
        If x > 0 Then Founditem = Sheets("Formulas").Columns(3).Find(What:=Finditem).Address Else Founditem = ""


If Finditem <> "" And Founditem <> "" Then

    Sheets("Margin Calculator").Cells(i, 13).Copy Sheets("Formulas").Range(Sheets("Formulas").Range(Founditem).Offset(0, 2).Address)

Else
    MsgBox ("Item not found.(" + Finditem + ") No action performed.")

End If

    i = i + 1
Loop

End Sub
 

Watch MrExcel Video

Forum statistics

Threads
1,127,272
Messages
5,623,752
Members
415,986
Latest member
C_Braga

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