I am trying to multiply different ranges in an excel sheet and running them when the multiplier value changes.
Sheet 1 has :
|    A    |    B    |    C    |    D    |
|---------|---------|---------|---------|
|   ABC   |   10    |   20    |    2.5  |
|   DED   |   5     |   15    |    1.7  |
Sheet 2 has:
Column A2: "5%" - Percentage value
Column A4: "10%" - Percentage value
I want to increase or decrease the value of B and C columns with 5% and D with 10%. Further, which will change and refresh the whole table in Sheet 1 when the values in Sheet 2 are changed.
Here is the code I am using and it is working for B and C rows but not for the second array:
    With Sheet1
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
        Dim arr() As Variant
        Dim arr2() As Variant
        arr = .Range("B2:C" & LastRow).Value
        arr2 = .Range("D2:D" & LastRow).Value
    End With
    GA1 = 1 + Sheet2.Range("A4").Value
    If Sheet2.Range("A4").Value <= 0 Then GA1 = 1
    GA2 = 1 + Sheet2.Range("A2").Value
    If Sheet2.Range("A2").Value <= 0 Then GA2 = 1
    Dim i As Long
    Dim m As Long
    For m = LBound(arr2, 1) To UBound(arr2, 1)
        arr2(m, 1) = arr2(m, 1) * GA1
    Next
    For i = LBound(arr, 1) To UBound(arr, 1)
        arr(i, 1) = arr(i, 1) * GA2
        arr(i, 2) = arr(i, 2) * GA2
    Next
    Sheet1.Range("B2").Resize(UBound(arr, 1), 2).Value = arr
    Sheet1.Range("D2").Resize(UBound(arr2)).Value = arr2
String method:
Sub IncreaseRangeTEST()
    Const SRC_FIRST_CELL As String = "A2"
    Const SRC_COLS_LIST As String = "B:C,D"
    Const LKP_CELLS_LIST As String = "A2,A4"
    Dim Sh1 As Worksheet
    Dim Sh2 As Worksheet
    Set wb1 = ActiveWorkbook
    Set Sh1 = wb1.Sheets("Sheet1")
    Set Sh2 = wb1.Sheets("Sheet2")
    Dim srg As Range, srCount As Long
    With Sht1.Range(SRC_FIRST_CELL)
    srCount = .Worksheet.Cells( _
            .Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row + 1
           If srCount < 1 Then Exit Sub ' no data
        Set srg = .Resize(srCount)
    End With
    Dim sCols() As String: sCols = Split(SRC_COLS_LIST, ",")
    Dim lCells() As String: lCells = Split(LKP_CELLS_LIST, ",")
    Dim rg As Range, Percentage, n As Long
    For n = 0 To UBound(sCols)
        Percentage = Sht2.Range(lCells(n)).Value
        If VarType(Percentage) = vbDouble Then
            If Percentage > 0 Then
                Set rg = srg.EntireRow.Columns(sCols(n))
                IncreaseRange rg, Percentage
            End If
        End If
    Next n
End Sub
Sub IncreaseRange( _
       ByVal rg As Range, _
       ByVal Percentage As Double)
    Dim rCount As Long: rCount = rg.Rows.Count
    Dim cCount As Long: cCount = rg.Columns.Count
    Dim Data()
    If rCount * cCount = 1 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
    Else
        Data = rg.Value
    End If
    Dim Factor As Double: Factor = 1 + Percentage
    Dim Value, r As Long, c As Long
    For r = 1 To rCount
        For c = 1 To cCount
            Value = Data(r, c)
            If VarType(Value) = vbDouble Then
                Data(r, c) = Data(r, c) * Factor
            End If
        Next c
    Next r
    rg.Value = Data
End Sub

Sub IncreaseRangeTEST()
    Const SRC_FIRST_CELL As String = "A2"
    Const SRC_COLS_LIST As String = "B:C,D"
    Const LKP_CELLS_LIST As String = "A2,A4"
    
    Dim srg As Range, srCount As Long
    
    With Sheet1.Range(SRC_FIRST_CELL)
        srCount = .Worksheet.Cells( _
            .Worksheet.Rows.Count, .Column).End(xlUp).Row - .Row + 1
        If srCount < 1 Then Exit Sub ' no data
        Set srg = .Resize(srCount)
    End With
        
    Dim sCols() As String: sCols = Split(SRC_COLS_LIST, ",")
    Dim lCells() As String: lCells = Split(LKP_CELLS_LIST, ",")
        
    Dim rg As Range, Percentage, n As Long
    
    For n = 0 To UBound(sCols)
        Percentage = Sheet2.Range(lCells(n)).Value
        If VarType(Percentage) = vbDouble Then
            If Percentage > 0 Then
                Set rg = srg.EntireRow.Columns(sCols(n))
                IncreaseRange rg, Percentage
            End If
        End If
    Next n
End Sub
Sub IncreaseRange( _
       ByVal rg As Range, _
       ByVal Percentage As Double)
    
    Dim rCount As Long: rCount = rg.Rows.Count
    Dim cCount As Long: cCount = rg.Columns.Count
    
    Dim Data()
    
    If rCount * cCount = 1 Then
        ReDim Data(1 To 1, 1 To 1): Data(1, 1) = rg.Value
    Else
        Data = rg.Value
    End If
    
    Dim Factor As Double: Factor = 1 + Percentage
    
    Dim Value, r As Long, c As Long
    
    For r = 1 To rCount
        For c = 1 To cCount
            Value = Data(r, c)
            If VarType(Value) = vbDouble Then
                Data(r, c) = Data(r, c) * Factor
            End If
        Next c
    Next r
    rg.Value = Data
End Sub

Option Explicit
Private Sub IncreaseRange(ByVal oMultiplier As Double, ByRef oTarget As Range)
Dim oValue As Variant
For Each oValue In oTarget
oValue.Value = oValue.Value * (1 + oMultiplier)
Next
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
Dim LastRow As Long
LastRow = Sheet1.Cells(Sheet1.Rows.Count, "A").End(xlUp).Row
Select Case Target.Address
Case "$A$2"
Call IncreaseRange(Target.Value, Sheet1.Range("B2:C" & LastRow))
Case "$A$4"
Call IncreaseRange(Target.Value, Sheet1.Range("D2:D" & LastRow))
End Select
End Sub