PDA

View Full Version : Solved: macro code need correction - inorder to generate correct % values



Pete
09-09-2008, 11:41 AM
Hi Experts

Need some help in correcting the following VBA Code. Here is the sequence.

when the user click the Apply % Change macro button in the worksheet "Scenario 1".....the following should happen.....

1. if the user enters 2 in column V2 against all products then all products increase by 2%.....

2. if the user clicks the RESET macro button then return values to back to there original value....

3. if then the user adds 3 to V3 then increase all carbs product by 3% (ONLY) and leave all other products still at 2% percent.....

4. if then the user adds 5 to v4 then increase all stllls products by 5% (ONLY) and leave all other products still at 2% percent..... and carbs at 3%....

5. if user clicks the reset button then reset all values back to there original value........which is a copy of the worksheet "New Business" column N

Pete
09-09-2008, 02:24 PM
For example, by the time you get to step 4, you would expect to see a 5% increase for all stllls products, a 3% increase for all carb products (not a 3% increase over top of the 3% increase applied in step 3) and a 2% increase for everything else (not a 2% increase over top of the 2% increase applied in step 3).

mdmackillop
09-10-2008, 12:19 AM
Your book still hangs excel. Can you transfer the sheet and macro to a new book with no links?
Suggestion.
Add a helper column and copy your original prices there. The code can then operate on these prices to show the amended ones. Reset will copy back the original prices and clear the helper column.

Pete
09-10-2008, 01:36 AM
Ok managed to solve the issue took about all night but here is the new code

Public Sub Apply() With Sheets("Scenario1") If .Range("U2") = 0 And .Range("U3") = 0 And .Range("U4") = 0 And .Range("U5") = 0 And .Range("X2") = 0 And .Range("X3") = 0 And .Range("X4") = 0 And .Range("X5") = 0 Then Exit Sub Application.Calculation = xlCalculationManual Dim rng As Range Set rng = Range(.Cells(10, 14), .Cells(Rows.Count, 14).End(xlUp)) Dim c As Range Dim v As Long For Each c In rng.Cells v = WorksheetFunction.VLookup(c.Offset(0, -12), Excel.Range("'New Business'!" & Range(Sheets("New Business").Cells(10, 2).Address, Sheets("New Business").Cells(Rows.Count, 14).End(xlUp).Address).Address), 13, False) If .Range("U3") <> 0 And LCase(c.Offset(0, -9)) = LCase(.Range("T3")) Then c.value = Round(v * (1 + (.Range("U3") / 100)), 0): GoTo Done If .Range("U4") <> 0 And LCase(c.Offset(0, -9)) = LCase(.Range("T4")) Then c.value = Round(v * (1 + (.Range("U4") / 100)), 0): GoTo Done If .Range("U5") <> 0 And LCase(c.Offset(0, -9)) = LCase(.Range("T5")) Then c.value = Round(v * (1 + (.Range("U5") / 100)), 0): GoTo Done If .Range("X2") <> 0 And LCase(c.Offset(0, -9)) = LCase(.Range("W2")) Then c.value = Round(v * (1 + (.Range("X2") / 100)), 0): GoTo Done If .Range("X3") <> 0 And LCase(c.Offset(0, -9)) = LCase(.Range("W3")) Then c.value = Round(v * (1 + (.Range("X3") / 100)), 0): GoTo Done If .Range("X4") <> 0 And LCase(c.Offset(0, -9)) = LCase(.Range("W4")) Then c.value = Round(v * (1 + (.Range("X4") / 100)), 0): GoTo Done If .Range("X5") <> 0 And LCase(c.Offset(0, -9)) = LCase(.Range("W5")) Then c.value = Round(v * (1 + (.Range("X5") / 100)), 0): GoTo Done If .Range("U2") <> 0 Then c.value = Round(v * (1 + (.Range("U3") / 100)), 0)Done: c.Font.Bold = True c.Font.Color = 255 Next c .Range("U2").Select Application.Calculation = xlCalculationAutomatic End WithEnd Sub Public Sub Reset() With Sheets("Scenario1") Application.Calculation = xlCalculationManual Dim rng As Range Set rng = Range(.Cells(10, 14), .Cells(Rows.Count, 14).End(xlUp)) Dim c As Range For Each c In rng.Cells c = WorksheetFunction.VLookup(c.Offset(0, -12), Excel.Range("'New Business'!" & Range(Sheets("New Business").Cells(10, 2).Address, Sheets("New Business").Cells(Rows.Count, 14).End(xlUp).Address).Address), 13, False) c.Font.Bold = False c.Font.Color = 0 Next c .Range("U2").Select Application.Calculation = xlCalculationAutomatic End WithEnd Sub