replace copied value to Table with a new calculated value and button

Question

I have a table which I insert rows to with this code:

Sub Invoice_InsertProduct()

If Sheet1.Range("Z6").Value = "" Then

MsgBox "Selecciona producto"
    Sheet1.Range("Z6").Select
    Else
      Dim ttCotizacion As ListObject
      Set ttCotizacion = Sheet1.ListObjects("tCotizacion")
      Dim FilaTabla As ListRow
      If ttCotizacion.ListRows.Count = 1 And Sheet1.Range("Z29").Value = "" Then
      Set FilaTabla = ttCotizacion.ListRows(1)
      FilaTabla.Range.Cells(1).Value = Sheet1.Range("X6").Value
      FilaTabla.Range.Cells(2).Value = Sheet1.Range("Y6").Value
      FilaTabla.Range.Cells(3).Value = Sheet1.Range("Z6").Value
      FilaTabla.Range.Cells(5).Value = Sheet1.Range("AF6").Value
      FilaTabla.Range.Cells(6).Value = Sheet1.Range("AG6").Value
      Else
      Set FilaTabla = ttCotizacion.ListRows.Add
      FilaTabla.Range.Cells(1).Value = Sheet1.Range("X6").Value
      FilaTabla.Range.Cells(2).Value = Sheet1.Range("Y6").Value
      FilaTabla.Range.Cells(3).Value = Sheet1.Range("Z6").Value
      FilaTabla.Range.Cells(5).Value = Sheet1.Range("AF6").Value
      FilaTabla.Range.Cells(6).Value = Sheet1.Range("AG6").Value
        End If
    Sheet1.Range("X6").Value = ""
    Sheet1.Range("Z6").Value = ""
    Sheet1.Range("B4").Select
End If
End Sub

Now what I want to do is after all rows are added to Table("tCotizacion"), user can use a button with a new Sub Prorate_UnitPrice() that will prorate proportionally a number named "nCostLogTot" (Y9) through all values that were copied to: FilaTabla.Range.Cells(6).Value = Sheet1.Range("AG6").Value 'Unit Price

The formula which gives the expected value would be:

'New Unit Price =IF(ISNUMBER("nCostLogT"),((tCotizacion[ProductAmount]/nTotalBalance)*nCostLogT)/tCotizacion[ProductQuantity],0) + FilaTabla.Range.Cells(6).Value = Sheet1.Range("AG6").Value

But necessary to go through all rows in Table (tCotizacion) to last row and replace previous value. Example would be:

nCostLogT= $600

ProductQuantity / Unit Price/ Product Amount

1. 100       /   $20     /     $ 2000
   

2. 200      /   $30     /      $ 6000
               nTotal Balance= $8000
   

Prorate Delivery Cost:

1. ((($2000/$8000)*600)/100)+20= $21.5 New Unit Price
2. ((($6000/$8000)*600)/200)+30= $32.25 New Unit Price

Expected table

ProductQuantity / Unit Price/ Product Amount

1. 100 / $21.5 / $ 2150
2. 200 / $32.25 / $ 6450 nTotal Balance= $8600

The table has 7 columns… header name are:

Column 1 = ProductQuantity
Column 2 = Unit
Column 3 = Product
Column 4 = SKU
Column 5 = DeliveryDay
Column 6 = UnitPrice
Column 7 = ProductAmount

Hope my explanation is clear enough for all.

TIA!!

Answer 1

• Opetion 1: add a temp col to calculate the new price

Microsoft documentation:

ListObject.ListColumns property (Excel)

ListColumn.DataBodyRange property (Excel)

Option Explicit

Sub UpdateTable1()
    Dim oTab As ListObject, lastCol As ListColumn
    Dim oSht As Worksheet
    Const PRICE_COL = "[UnitPrice]"
    Const TAB_NAME = "tCotizacion"
'    Const TAB_NAME = "Table1" ' for testing
    Set oSht = ActiveSheet
    If IsNumeric(Range("nCostLogT").Value) Then
        Set oTab = oSht.ListObjects(TAB_NAME)
        With oTab
            With .HeaderRowRange
                .Cells(.Cells.Count).Offset(, 1).Value = "TempCol"
            End With
            Set lastCol = .ListColumns(.ListColumns.Count)
            lastCol.DataBodyRange.FormulaR1C1 = "=(([@ProductAmount]/SUM([ProductAmount])*nCostLogT/[@ProductQuantity])+[@UnitPrice])"
            oSht.Range(.Name & PRICE_COL).Value = lastCol.DataBodyRange.Value
            lastCol.Range.Clear
            .Resize .Range.Resize(, .ListColumns.Count - 1)
        End With
    End If
End Sub

---

• Opetion 2: load table into an array and calculate the new price

Sub UpdateTable2()
    Dim oTab As ListObject, lastCol As ListColumn
    Dim oSht As Worksheet, arrData, i As Long
    Dim TotalAmt As Double, CostLog As Double
    Dim iQty As Long, iPrice As Long, iAmt As Long
    Const QTY_COL = "ProductQuantity"
    Const PRICE_COL = "UnitPrice"
    Const AMT_COL = "ProductAmount"
    Const TAB_NAME = "tCotizacion"
    ' Const TAB_NAME = "Table1" ' for testing
    Set oSht = ActiveSheet
    If IsNumeric(Range("nCostLogT").Value) Then
        CostLog = Range("nCostLogT").Value
        Set oTab = oSht.ListObjects(TAB_NAME)
        With oTab
            iQty = .ListColumns(QTY_COL).Index
            iPrice = .ListColumns(PRICE_COL).Index
            iAmt = .ListColumns(AMT_COL).Index
            TotalAmt = Application.Sum(.ListColumns(iAmt).DataBodyRange)
            arrData = .DataBodyRange.Value
            For i = 1 To UBound(arrData)
                arrData(i, iPrice) = ((arrData(i, iAmt) / TotalAmt) * CostLog / arrData(i, iQty)) + arrData(i, iPrice)
            Next
            .DataBodyRange.Value = arrData
        End With
    End If
End Sub