VBA Sub to make calculations for all rows

Question

I have working code for a VBA program that returns the commission of a client, based on his/her case, however I can only have it calculate one client.

In my Excel table, each row has specific data, as shown.

How can I change this code to have it calculate many rows all at once?

Sub komisijas_calc_Click()

'Declare the variables
Dim klienta_nr As Long
Dim ISIN As String
Dim Cena As Double
Dim Skaits As Double
Dim Komisija As Double
Dim vk As String
Dim Summa As Double

'Application.ScreenUpdating = False
Set kSheet = ThisWorkbook.Sheets("spec_klienti")


klienta_nr = Range("B2").Value
ISIN = Range("E2").Value
Cena = Range("H2").Value
Skaits = Range("I2").Value
vk = Range("D2").Value
Summa = Cena * Skaits


Select Case klienta_nr

'Special klient cases

    Case 10
                '(Vācija, Francija, Nīderlandes, Itālija, Īrija) - 30 EUR MIN
                If klienta_nr = 10 And (Left(ISIN, 2) = "DE" Or Left(ISIN, 2) = "FR" Or Left(ISIN, 2) = "NL" Or Left(ISIN, 2) = "IT" Or Left(ISIN, 2) = "IE") Then
                    Komisija = Summa * 0.01
                    ActiveCell.Value = Komisija
                    End If
                If klienta_nr = 10 And Komisija <= 30 Then
                    ActiveCell.Value = 30
                    End If

                'Case where klient is special, but ISIN doesn't apply
                If klienta_nr = 10 And (Left(ISIN, 2) <> "DE" Or Left(ISIN, 2) <> "FR" Or Left(ISIN, 2) <> "NL" Or Left(ISIN, 2) <> "IT" Or Left(ISIN, 2) <> "IE") Then
                    Komisija = Summa * 0.003
                    If Komisija >= 40 Then
                        ActiveCell.Value = 40
                        End If
                End If


    Case 11 
                '(Vācija, Francija, Nīderlandes, Itālija, Īrija) - 30 EUR MIN
                If klienta_nr = 11 And (Left(ISIN, 2) = "DE" Or Left(ISIN, 2) = "FR" Or Left(ISIN, 2) = "NL" Or Left(ISIN, 2) = "IT" Or Left(ISIN, 2) = "IE") Then
                    Komisija = Summa * 0.01
                    ActiveCell.Value = Komisija
                    End If
                'Set 30 EUR Min
                If klienta_nr = 11 And Komisija <= 30 Then
                    ActiveCell.Value = 30
                    End If

        'End If


    Case 12 
                '(Ziemeļvastu, Lietuvas, Igaunijas, Vācijas, Francijas, Nīderlandes, Itālijas, Īrijas, Austijas, Beļģijas, Spānijas, Portugāles)
                If klienta_nr = 12 And (Left(ISIN, 2) = "NO" Or Left(ISIN, 2) = "SE" Or Left(ISIN, 2) = "DK" Or Left(ISIN, 2) = "FI" Or Left(ISIN, 2) = "IS" Or Left(ISIN, 2) = "LT" Or Left(ISIN, 2) = "EE" Or Left(ISIN, 2) = "DE" Or Left(ISIN, 2) = "FR" Or Left(ISIN, 2) = "NL" Or Left(ISIN, 2) = "IT" Or Left(ISIN, 2) = "IE" Or Left(ISIN, 2) = "AT" Or Left(ISIN, 2) = "BE" Or Left(ISIN, 2) = "ES" Or Left(ISIN, 2) = "PT") Then
                    Komisija = Summa * 0.002
                    ActiveCell.Value = Komisija
                    End If
                '(ASV)
                If klienta_nr = 12 And (Left(ISIN, 2) = "US") Then
                    Komisija = Summa * 0.002
                    End If
                '(Lielbritānijas)
                If klienta_nr = 12 And (Left(ISIN, 2) = "UK") Then
                    Komisija = Summa * 0.002
                    ActiveCell.Value = Komisija
                    End If
                '(Šveices)
                If klienta_nr = 12 And (Left(ISIN, 2) = "CH") Then
                    Komisija = Summa * 0.002
                    ActiveCell.Value = Komisija
                    End If
                'Set 20 [valūte] MIN
                If klienta_nr = 12 And Komisija <= 20 Then
                    ActiveCell.Value = 20
                    End If


    Case 13 
                '(Ziemeļvastu, Lietuvas, Igaunijas, Vācijas, Francijas, Nīderlandes, Itālijas, Īrijas, Austijas, Beļģijas, Spānijas, Portugāles)
                If klienta_nr = 13 And (Left(ISIN, 2) = "NO" Or Left(ISIN, 2) = "SE" Or Left(ISIN, 2) = "DK" Or Left(ISIN, 2) = "FI" Or Left(ISIN, 2) = "IS" Or Left(ISIN, 2) = "LT" Or Left(ISIN, 2) = "EE" Or Left(ISIN, 2) = "DE" Or Left(ISIN, 2) = "FR" Or Left(ISIN, 2) = "NL" Or Left(ISIN, 2) = "IT" Or Left(ISIN, 2) = "IE" Or Left(ISIN, 2) = "AT" Or Left(ISIN, 2) = "BE" Or Left(ISIN, 2) = "ES" Or Left(ISIN, 2) = "PT") Then
                    Komisija = Summa * 0.002
                    ActiveCell.Value = Komisija
                    End If
                '(ASV)
                If klienta_nr = 13 And (Left(ISIN, 2) = "US") Then
                    Komisija = Summa * 0.002
                    ActiveCell.Value = Komisija
                    End If
                '(Lielbritānijas)
                If klienta_nr = 13 And (Left(ISIN, 2) = "UK") Then
                    Komisija = Summa * 0.002
                    ActiveCell.Value = Komisija
                    End If
                '(Šveices)
                If klienta_nr = 13 And (Left(ISIN, 2) = "CH") Then
                    Komisija = Summa * 0.002
                    ActiveCell.Value = Komisija
                    End If
                'Set 20 [valūte] MIN
                If klienta_nr = 13 And Komisija <= 20 Then
                    ActiveCell.Value = 20
                    End If


    Case 14 
                '(ASV)
                If klienta_nr = 14 And (Left(ISIN, 2) = "US") Then
                    Komisija = Summa * 0.0027
                    ActiveCell.Value = Komisija
                    End If
                'Set 40 USD MIN
                If klienta_nr = 14 And Komisija <= 40 Then
                    ActiveCell.Value = 40
                    End If



    'Non-special klient cases
    Case Else
            If Not Application.Match(klienta_nr, kSheet.Range("A2:A100")) Then
              'IP2, 0.03% komisija, 40 EUR/USD Max
                 If Right(vk, 1) = 1 Or Right(vk, 1) = 8 Then
                    Komisija = Summa * 0.003
                    ActiveCell.Value = Komisija
                    End If
              'IP1, 0.1% komisija, 40 EUR/USD Max
                If Right(vk, 1) = 7 Then
                    Komisija = Summa * 0.01
                    ActiveCell.Value = Komisija
                    End If
                'Komisija MAX is 40, so anything >=40 equals 40
                If Komisija >= 40 Then
                    ActiveCell.Value = 40
                    End If
            End If
End Select
End Sub

Vityata · Accepted Answer

Here is a good way to start. Write some values in column 5 and run this code step by step:

Option Explicit

Public Sub TestMe()

    Dim lngFirstRow As Long: lngFirstRow = 1
    Dim lngLastRow  As Long
    Dim lngCol      As Long: lngCol = 5
    Dim lngCounter  As Long

    With Worksheets(1)
        lngLastRow = .Cells(.Rows.Count, lngCol).End(xlUp).Row
        For lngCounter = lngFirstRow To lngLastRow
            .Cells(lngCounter, lngCol) = lngCounter + lngCol
            'here should come more business logic
        Next lngCounter

    End With

End Sub

It would show you how to loop through rows in a spreadsheet. Then, you can add code within the loop, to make it workable (the place where I wrote "Here should come more business logic"). In general, that would be enough.

VBA Sub to make calculations for all rows

Answers (2)

Related Questions