[Tasos]

Καλημέρα Θανάση και καλωσόρισες στην παρέα μας!

Όρισε τα παρακάτω ονόματα στο φύλλο "Request For Quotations":

1. Owver: Αναφορά στο κελί $N$2
2. Supplier: Αναφορά στο κελί $O$2

Συμπλήρωσε τις τιμές στα παραπάνω κελιά και χρησιμοποίησε τον παρακάτω κώδικα (για Excel > 2003) :

Option Explicit

Sub Offer()
    Dim FirstRow As Long, FinalRow As Long, CalcRows As Long
    FirstRow = ActiveCell.Row
    FinalRow = Cells(Rows.Count, 2).End(xlUp).Row
    CalcRows = FinalRow - FirstRow + 1
    If Not IsNumeric(Range("Owners")) Or IsEmpty(Range("Owners")) _
       Or Not IsNumeric(Range("Supplier")) Or IsEmpty(Range("Supplier")) Then
        ' Code will exit. Show some message...
        Exit Sub
    End If
    If CalcRows < 1 Then
        'Can not be a valid Range... Show some message...
    End If

    Application.ScreenUpdating = False
    ' Cost Net
    With Range("K" & FirstRow & ":K" & FinalRow)
        .FormulaR1C1 = "=IF(RC[-1]<>"""",ROUND(RC[-1]*(1-Supplier%),2),"""")"
        .Value = .Value    'Convert Formulas to Values
    End With
    '   Unit Price

    With Range("I" & FirstRow & ":I" & FinalRow)
        .FormulaR1C1 = "=IFERROR(ROUND(RC[2]*(1+Owners%),2), """")"
        .Value = .Value
    End With

    ' Total Cost
    With Range("L" & FirstRow & ":L" & FinalRow)
        .FormulaR1C1 = "=IF(RC[-1]<>"""",RC[-4]*RC[-1],"""")"
        .Value = .Value
    End With

    ' Total Sales
    With Range("M" & FirstRow & ":M" & FinalRow)
        .FormulaR1C1 = "=IF(RC[-4]<>"""",RC[-5]*RC[-4],"""")"
        .Value = .Value
    End With

    ' Enter the Total Row
    FirstRow = FinalRow - 2

    Range("K3").Copy
    With Range("K" & FinalRow + 1).Resize(4, 3)
        .PasteSpecial xlPasteFormats
        Application.CutCopyMode = False
        .Font.Bold = True
        .Font.Italic = True
        With .Resize(1, 3)

            '____________________________________Sum from selected Row________________________________

            '.Item(1).Value = "Total"
            '.Item(2).FormulaR1C1 = "=SUM(R[-" & CalcRows & "]C:R[-1]C)"
            '.Item(3).Formula = "=SUM(R[-" & CalcRows & "]C:R[-1]C)"
            '.Font.ColorIndex = xlAutomatic
            'With .Offset(1).Resize(3, 3)
                '.Item(1).Value = "Profit"
                '.Item(3).FormulaR1C1 = "=SUM(R[-" & CalcRows + 1 & "]C:R[-2]C)- SUM(R[-" & CalcRows + 1 & _
                                       "]C[-1]:R[-2]C[-1])"
                '.Item(4).Value = "P/C"
                '.Item(6).FormulaR1C1 = "=(SUM(R[-" & CalcRows + 2 & "]C:R[-3]C)- SUM(R[-" & CalcRows + 2 & _
                                       "]C[-1]:R[-3]C[-1]))/(SUM(R[-" & CalcRows + 2 & "]C[-1]:R[-3]C[-1]))"
                '.Item(6).NumberFormat = "0.00%"
                '.Item(7).Value = "P/S"
                '.Item(9).FormulaR1C1 = "=(SUM(R[-" & CalcRows + 3 & "]C:R[-4]C)- SUM(R[-" & CalcRows + 3 & _
                                       "]C[-1]:R[-4]C[-1]))/(SUM(R[-" & CalcRows + 3 & "]C:R[-4]C))"
                '.Item(9).NumberFormat = "0.00%"
                '.Font.ColorIndex = 41&
           ' End With
            '.Value = .Value    'Convert Formulas to Values

            '____________________________________Sum from the first Row__________________________________________

            .Item(1).Value = "Total"
            .Item(2).FormulaR1C1 = "=SUM(R[-" & FirstRow & "]C:R[-1]C)"
            .Item(3).Formula = "=SUM(R[-" & FirstRow & "]C:R[-1]C)"
            .Font.ColorIndex = xlAutomatic
            With .Offset(1).Resize(3, 3)
                .Item(1).Value = "Profit"
                .Item(3).FormulaR1C1 = "=SUM(R[-" & FirstRow + 1 & "]C:R[-2]C)- SUM(R[-" & FirstRow + 1 & _
                                       "]C[-1]:R[-2]C[-1])"
                .Item(4).Value = "P/C"
                .Item(6).FormulaR1C1 = "=(SUM(R[-" & FirstRow + 2 & "]C:R[-3]C)- SUM(R[-" & FirstRow + 2 & _
                                       "]C[-1]:R[-3]C[-1]))/(SUM(R[-" & FirstRow + 2 & "]C[-1]:R[-3]C[-1]))"
                .Item(6).NumberFormat = "0.00%"
                .Item(7).Value = "P/S"
                .Item(9).FormulaR1C1 = "=(SUM(R[-" & FirstRow + 3 & "]C:R[-4]C)- SUM(R[-" & FirstRow + 3 & _
                                       "]C[-1]:R[-4]C[-1]))/(SUM(R[-" & FirstRow + 3 & "]C:R[-4]C))"
                .Item(9).NumberFormat = "0.00%"
                .Font.ColorIndex = 41&
            End With
            '.Value = .Value 'Convert Formulas to Values

            '____________________________________________________________________________________________________
            
        End With
    End With
    Application.ScreenUpdating = True
End Sub

Καλή συνέχεια!

Φιλικά

Τάσος