Increase / Decrease column values by % within a cell + Change History.

A11 Mighty · Apr 20, 2022

Hello -
Looking for a way to simplify a process I inherited and I am sure there's a better way to perform all these tasks using Macros. This is just a portion of the steps I am performing, so I will be submitting a separate thread for each to avoid complicating my request and make it more manageable.

1st Task - Be able to increase or decrease values with a specific column based on a cell value.
Example : The values I need to update are within column "G" updated values should be recorded in column "H" and the +/- % change value is in cell P3.

2nd Task - The second time a % change is made, the values in column "H" should be transferred to column "G" (Become the current List price) and Column H will contain the updated values with the applied +/- % change.

3rd Task - Would like to maintain a record of who, when and what changes were made to the file and be recorded in a separate sheet.
Example: Reference attachment Sheet " CHANGE History". Any information that can be captured and enable some form of tracking and provide a source to go to if questions arise.
All of these tasks can be done simultaneously or done by following a step by step kinda approach.

Any help will be much appreciated!

A11 Mighty

rollis13 · Apr 21, 2022

Have a try with what I came up with; to be pasted in a module:

Code:

Option Explicit
Sub UpdateListPrice()
    Dim lastrowH As Long
    Dim lastrowG As Long
    Dim newrowCH As Long
    Dim multiplier
    Dim listCell As Range
    With Sheets("SHANDOO RQ1")
        'find last row column H
        lastrowH = .Range("H" & Rows.Count).End(xlUp).Row
        'copy H on G only if H has data
        If lastrowH <> 1 Then .Range("H2:H" & lastrowH).Cut Destination:=.Range("G2:G" & lastrowH)
        multiplier = .Range("P3").Value
        'find last row column G
        lastrowG = .Range("G" & Rows.Count).End(xlUp).Row
        'loop and create new Updated List Price
        For Each listCell In .Range("G2:G" & lastrowG)
            .Range("H" & listCell.Row) = listCell.Value * (1 + multiplier)
        Next listCell
    End With
    With Sheets("CHANGE History")
        newrowCH = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & newrowCH).Value = Environ("USERNAME")
        .Range("B" & newrowCH).Value = Format(Now(), "dddd dd mmmm yyyy, h:mm AM/PM")
        .Range("C" & newrowCH).Value = "Decrease or Increase %"
        .Range("D" & newrowCH).Value = multiplier
        .Range("D" & newrowCH).NumberFormat = "0.00%"
    End With
End Sub

Marc L · Apr 21, 2022

Hello, according to the attachment an Excel basics VBA demonstration for starters :

Code:

Sub Demo1()
        Dim P$
    With ['SHANDOO RQ1'!A1].CurrentRegion.Rows
            P = .Range("P3").Text
        With .Item("2:" & .Count).Columns("G:H")
            If Application.Count(.Item(2)) Then .Item(1).Value2 = .Item(2).Value2
           .Item(2).Value2 = .Parent.Evaluate(.Item(1).Address & "*(1+" & P & ")")
        End With
    End With
    With ['Change History'!A1].End(xlDown)(2).Resize(, 4)
        .Cells(2).NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
        .Value2 = Array(Environ("USERNAME"), Date, IIf(Val(P) < 0, "De", "In") & "crease %", P)
    End With
End Sub

Do you like it ? So thanks to click on bottom right Like !

A11 Mighty · Apr 21, 2022

Morning Marc L & rollis13 - Can't thank you both enough for the great solutions. Both work perfectly with one minor exception.

In sheet "Change History" the Type of change doesn't seem to recognize if we applied a % decrease or an increase to the current list price. Is there a way to have it recognize which type we applied? Apologize, if my initial request was not clear.

Appreciate all your help!

Thank you

A11 Mighty

rollis13 · Apr 21, 2022

Rewrite this part of the macro:

Code:

'...
.Range("B" & newrowCH).Value = Format(Now(), "dddd dd mmmm yyyy, h:mm AM/PM")
'--- added/changed ---
If multiplier < 0 Then
    .Range("C" & newrowCH).Value = "Decrease %"
Else
    .Range("C" & newrowCH).Value = "Increase %"
End If
'---------------------
.Range("D" & newrowCH).Value = multiplier
'...

Marc L · Apr 21, 2022

A11 Mighty said:
Is there a way to have it recognize which type we applied?

Codeline updated in post #3 …

A11 Mighty said:
Can't thank you both enough for the great solutions.

But you can : just click on bottom right Like !

A11 Mighty · Apr 21, 2022

Again, thank you both for the great solutions. This is really helpful and make some of my tasks a breeze and helps minimize errors.

A11 Mighty

rollis13 · Apr 21, 2022

Thanks for the positive feedback, glad we were able to help

.

A11 Mighty · Apr 22, 2022

Morning -

Is there a way to modify the code provided to update certain values based on the selection through a drop down option or a popup option that would ask the user to select which Product Line from column "B" and then apply the desired %. Additionally, enable it to capture the information of what specific product line the % has been applied to within the Change History sheet.
I've attached an updated sample of the desired outcome for reference.

Thanks again for the assistance.

A11 Mighty

rollis13 · Apr 22, 2022

This could be your Button2_Click macro:

Code:

Sub Button2_Click()
    Dim lastrowH As Long
    Dim lastrowG As Long
    Dim newrowCH As Long
    Dim multiplier
    Dim listCell As Range
    With Sheets("SHANDOO RQ1")
        'find last row column H
        lastrowH = .Range("H" & Rows.Count).End(xlUp).Row
        'copy H on G only if H has data
        If lastrowH <> 1 Then .Range("H2:H" & lastrowH).Cut Destination:=.Range("G2:G" & lastrowH)
        multiplier = .Range("P8").Value           '<- changed
        'find last row column G
        lastrowG = .Range("G" & Rows.Count).End(xlUp).Row
        'loop and create new Updated List Price
        For Each listCell In .Range("G2:G" & lastrowG)
            '--- changed/added ---
            If listCell.Offset(0, -5).Value = .Range("P6").Value Then
                .Range("H" & listCell.Row) = listCell.Value * (1 + multiplier)
            Else
                .Range("H" & listCell.Row) = listCell.Value
            End If
            '---------------------
        Next listCell
    End With
    With Sheets("CHANGE History")
        newrowCH = .Range("A" & Rows.Count).End(xlUp).Row + 1
        .Range("A" & newrowCH).Value = Environ("USERNAME")
        .Range("B" & newrowCH).Value = Format(Now(), "dddd dd mmmm yyyy, h:mm AM/PM")
        If multiplier < 0 Then
            .Range("C" & newrowCH).Value = "Decrease %"
        Else
            .Range("C" & newrowCH).Value = "Increase %"
        End If
        .Range("D" & newrowCH).Value = multiplier
        .Range("D" & newrowCH).NumberFormat = "0%"
        .Range("E" & newrowCH).Value = Sheets("SHANDOO RQ1").Range("P6").Value '<- changed
    End With
End Sub

But this is a completely different topic so I think you should've created a new thread.

Marc L · Apr 22, 2022

According to post #9 attachment an Excel basics VBA demonstration :

Code:

Sub AddPercentage(K$, L$, P$, Optional C&)
    With Sheet1.[A1].CurrentRegion.Rows("2:" & Sheet1.[A1].CurrentRegion.Rows.Count).Columns
         If Application.Count(.Item(8)) Then .Item(7).Value2 = .Item(8).Value2
        .Item(8).Value2 = .Parent.Evaluate("IF(" & .Item(2).Address & K & """" & L & Replace(""",#*(1+" & P & "),#)", "#", .Item(7).Address))
    End With
    With Sheet2.[A1].End(xlDown)(2).Resize(, 5)
        .Cells(2).NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
        .Value2 = Array(Environ("USERNAME"), Date, IIf(Val(P) < 0, "De", "In") & "crease %", P, L)
         If C Then .Cells(5).Interior.Color = C
    End With
End Sub

Sub Button1_Click()
    AddPercentage "<>", "ALL", Sheet1.[P3].Text
End Sub

Sub Button2_Click()
    With Sheet1.[P6]:  AddPercentage "=", .Text, .Cells(3).Text, .Interior.Color:  End With
End Sub

You may Like it !

Marc L · Apr 23, 2022

According to post #9 attachment another way is to allocate the same VBA procedure for each button

like this Excel basics VBA demonstration to paste only to the Sheet1 (SHANDOO RQ1) worksheet module :

Code:

Sub ApplyPercentage()
    Dim V
        If Not IsError(Application.Caller) Then V = Shapes(Application.Caller).TextFrame.Characters.Text
        If V = "APPPLY % TO ALL" Then V = Array("<>", "ALL", [P3].Text) Else V = Array("=", [P6].Text, [P8].Text, [P6].Interior.Color)
    With [A1].CurrentRegion.Rows("2:" & [A1].CurrentRegion.Rows.Count).Columns
        If Application.Count(.Item(8)) Then .Item(7).Value2 = .Item(8).Value2
       .Item(8).Value2 = Evaluate("IF(" & .Item(2).Address & V(0) & """" & V(1) & Replace(""",#*(1+" & V(2) & "),#)", "#", .Item(7).Address))
    End With
    With Sheet2.[A1].End(xlDown)(2).Resize(, 5)
       .Cells(2).NumberFormat = "[$-F800]dddd, mmmm dd, yyyy"
       .Value2 = Array(Environ("USERNAME"), Date, IIf(Val(P) < 0, "De", "In") & "crease %", V(2), V(1))
        If UBound(V) > 2 Then .Cells(5).Interior.Color = V(3)
    End With
End Sub

You should Like it !

A11 Mighty · Apr 25, 2022

Thank you guys, both solutions work perfectly.
A11 Mighty

rollis13 · Apr 25, 2022

Thanks for the positive feedback

, glad we were able to help.

Increase / Decrease column values by % within a cell + Change History.

A11 Mighty

Member

Attachments

rollis13

Member

Marc L

Excel Ninja

A11 Mighty

Member

rollis13

Member

Marc L

Excel Ninja

A11 Mighty

Member

rollis13

Member

A11 Mighty

Member

Attachments

rollis13

Member

Marc L

Excel Ninja

Marc L

Excel Ninja

A11 Mighty

Member

rollis13

Member