I wrote a fully working VBA macro that goes through inputed client ID's and returns the specified commission fee for that client.
The code 100% works, however I need to have it so that my boss is able to easily add new clients with their special commission %'s to the list, without having to go through the VBA code.
How can I make a simplified VBA macro or just type an Excel function to do exactly what my code below does, but make it versitile to the special klient table?
The main Excel table looks like this:
The table with the special klients, commission fees, currency, markets, looks like this:
Option Explicit
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
Dim kSheet As Worksheet
Dim lngFirstRow As Long: lngFirstRow = 2
Dim lngLastRow As Long
Dim lngCol As Long: lngCol = 2
Dim lngCounter As Long
Dim lngKom As Long: lngKom = 11
Set kSheet = ThisWorkbook.Sheets("spec_klienti")
With Worksheets(1)
lngLastRow = .Cells(.Rows.Count, lngCol).End(xlUp).Row
For lngCounter = lngFirstRow To lngLastRow
klienta_nr = Range("B" & lngCounter).Value
ISIN = Range("E" & lngCounter).Value
Cena = Range("H" & lngCounter).Value
Skaits = Range("I" & lngCounter).Value
vk = Range("D" & lngCounter).Value
Summa = Cena * Skaits
Select Case klienta_nr
Case 111111
'(Vācija, Francija, Nīderlandes, Itālija, Īrija) - 30 EUR MIN
If klienta_nr = 111111 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
.Cells(lngCounter, lngKom) = Komisija
End If
If klienta_nr = 111111 And Komisija <= 30 Then
.Cells(lngCounter, lngKom) = 30
End If
If klienta_nr = 1111111 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
.Cells(lngCounter, lngKom) = 40
End If
End If
Case 2222222
'(Vācija, Francija, Nīderlandes, Itālija, Īrija) - 30 EUR MIN
If klienta_nr = 222222 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
.Cells(lngCounter, lngKom) = Komisija
End If
'Set 30 EUR Min
If klienta_nr = 2222222 And Komisija <= 30 Then
.Cells(lngCounter, lngKom) = 30
End If
If klienta_nr = 2 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
GoTo AllElseFails
End If
Case Else
AllElseFails:
'IP2, 0.03% komisija, 40 EUR/USD Max
If Right(vk, 1) = 1 Or Right(vk, 1) = 8 Then
Komisija = Summa * 0.003
.Cells(lngCounter, lngKom) = Komisija
End If
'IP1, 0.1% komisija, 40 EUR/USD Max
If Right(vk, 1) = 7 Then
Komisija = Summa * 0.01
.Cells(lngCounter, lngKom) = Komisija
End If
'Komisija MAX is 40, so anything >=40 equals 40
If Komisija >= 40 Then
.Cells(lngCounter, lngKom) = 40
End If
'End If
End Select
Next lngCounter
End With
End Sub