Find value via loop in another worksheet and change it

[wtom0412]

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.

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

 

[Puertorekinsam]

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)

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]

hold

 

[Puertorekinsam]

Sorry... I did the cell reference backwards. The row is first, the column is second.

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]

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...

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]

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

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]

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 Blend	Bergamot Oil* (Bergaptene-Free)	21.000%
2.00%	2Essential Oil Blend	Cedarwood Atlas Oil*	22.000%
3.00%	3Essential Oil Blend	Cinnamon Essential Oil*	23.000%
4.00%	4Essential Oil Blend	Ginger Root Oil*	24.000%
5.00%	5Essential Oil Blend	Orange (Sweet) Oil*	25.000%
6.00%	6Essential Oil Blend	Patchouli 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 Blend	Bergamot Oil* (Bergaptene-Free)	21.00%
2Essential Oil Blend	Cedarwood Atlas Oil*	22.00%
3Essential Oil Blend	Cinnamon Essential Oil*	23.00%
4Essential Oil Blend	Ginger Root Oil*	24.00%
5Essential Oil Blend	Orange (Sweet) Oil*	25.00%
6Essential Oil Blend	Patchouli Oil*	26.00%
1Release Balm	Arnica Extract*	10.00%
2Release Balm	Carnauba Wax*	11.00%
3Release Balm	Castor 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?

If FoundItem <> "" Then

 

[Puertorekinsam]

Now that is a horse of a different color... try this:

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]

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

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

on the second loop?

Cheers, Toby

 

[Puertorekinsam]

also updated the code so it shows you "what" wasn't found

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