-1

I have created a function that calculates a client's commission based on many variables.

The first problem I'm having is a Circular Reference Error. I understand what it means, but I can't quite figure out where the error is deriving from.

The second issue is that my ISIN, Cena, Skaits, and VK values are set to a certain cell, but I would like them to be equal to the values of the current row. If this doesn't make sense, please ask.

Private Sub CommandButton1_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 x As Integer

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


'Set variables equal to the cell data
'-----------------------------------------------------------
'I NEED TO SET THESE TO BE EQUAL TO THE CURRENT ROW'S VALUES
'-----------------------------------------------------------
klienta_nr = Range("B2").Value
ISIN = Range("E2").Value
Cena = Range("H2").Value
Skaits = Range("I2").Value
vk = Range("D2").Value
Summa = Cena * Skaits




'---------------------------------------------------------------------------------------------
'Start Cases
'---------------------------------------------------------------------------------------------
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
Nikolajs
  • 325
  • 1
  • 3
  • 17
  • 1
    The first issue: you wrote a `Function`, but this routine has no return value. Considering what it seems to do at first glance, shouldn't it be a `Sub`? You're changing the `ActiveCell.value` - A function should just have a return value, so that when it's called you can do `ActiveCell.Value = yourfunction(parameters)` – Rik Sportel Jul 10 '17 at 07:11
  • I don't see any circular reference error in the code itself - For sure make it into a `sub`. Also have a look at [how to avoid select / activate](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros) – Rik Sportel Jul 10 '17 at 07:15
  • Making it a Sub does work. If I want to calculate the commissions for several rows, with data being taken from each row, how should I assign the variables? – Nikolajs Jul 10 '17 at 07:21

2 Answers2

0

Try something like this:

Make a selection anywhere in the sheet and make your Sub loop over each row that is in the current selection.

Sub komisija_calc(klienta_nr As Double)

'Declare the variables
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 x As Integer

Dim rng As Range 'Added variable

Application.ScreenUpdating = False
Set kSheet = ThisWorkbook.Sheets("komisijas")
'Getting rid off Worksheets("Order Machine").Activate

'Set variables equal to the cell data
'We'll loop over the rows in the selection instead of what you did:
'Maybe add a check to ensure the selection is only one column, otherwise you'll do more loops than neccessary:

For Each rng In Selection 'START LOOP! - Selection is still bad - you might want to get your rows in another way, the loop is for demonstration purposes.
    With Worksheets("Order Machine") 
        ISIN = .Range("E" & rng.Row).Value
        Cena = .Range("H" & rng.Row).Value
        Skaits = .Range("I" & rng.Row).Value
        vk = .Range("B" & rng.Row).Value
        Summa = Cena * Skaits

        '-----------
        'Start Cases
        '-----------
        Select Case klienta_nr
        'Special klient cases
        '... all your code here...
            .Range("A" & rng.Row).Value = Komisija 'To put the commission in column A of "Order Machine" worksheet. Change as needed.
        End Select
    End With
Next rng 'Next row in selection.
End Sub

Edit: I assume you want the "current row" to be equal to the ActiveCell / the current selection. You then only have to replace:

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

With:

klienta_nr = Range("B" & ActiveCell.Row).Value
ISIN = Range("E" & ActiveCell.Row).Value
Cena = Range("H" & ActiveCell.Row).Value
Skaits = Range("I" & ActiveCell.Row).Value
vk = Range("D" & ActiveCell.Row).Value
Summa = Cena * Skaits

I'm assuming that your ActiveCell is on the same worksheet as these input values, when you run this macro? Let's say your activecell is "S5", then this will take klienta_nr from cell "B5".

I can't stress enough that you should really try to avoid using .Activate, ActiveCell, Selection, etc. etc.

Rik Sportel
  • 2,661
  • 1
  • 14
  • 24
  • Thank you for this, but it still doesn't appear to be working. I had it working before, but it would only return the commission for one row. I want to have it so that it can return the commission of each row's values. I can post my code for my previously working sub. – Nikolajs Jul 10 '17 at 08:53
  • Please edit the question indeed, I'll rewrite the answer. – Rik Sportel Jul 10 '17 at 08:59
  • See edit - If your active cell is "S5", this will take the input from "B5". – Rik Sportel Jul 10 '17 at 10:43
0

If you are writing a VBA function that must be called form a worksheet cell (also know as a User Defined Function), you MUST make sure that ALL cells the function needs are passed as arguments. So (without optimising your code), I think this is what should work:

Function komisija_calc(klienta_nr As Double, ISIN As String, Cena As Double, _
                        Skaits As Double, Vk As String, ClientNumbers As Range)

'Declare the variables
    Dim Komisija As Double
    Dim Summa As Double

    'Set variables equal to the cell data
    '-----------------------------------------------------------
    'I NEED TO SET THESE TO BE EQUAL TO THE CURRENT ROW'S VALUES
    '-----------------------------------------------------------
    Summa = Cena * Skaits


    '--------------------------------------------------------------------------
    'Loop through Column A until blank
    '-------------------------------------------------------------------------


    '---------------------------------------------------------------------------------------------
    'Start Cases
    '---------------------------------------------------------------------------------------------
    Select Case klienta_nr

        'Special klient cases


    Case 10
        '(Vacija, Francija, Niderlandes, Italija, Irija) - 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
            komisija_calc = Komisija
        End If
        If klienta_nr = 10 And Komisija <= 30 Then
            komisija_calc = 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
                komisija_calc = 40
            End If
        End If


    Case 11
        '(Vacija, Francija, Niderlandes, Italija, Irija) - 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
            komisija_calc = Komisija
        End If
        'Set 30 EUR Min
        If klienta_nr = 11 And Komisija <= 30 Then
            komisija_calc = 30
        End If

        'End If


    Case 12
        '(Ziemelvastu, Lietuvas, Igaunijas, Vacijas, Francijas, Niderlandes, Italijas, Irijas, Austijas, Belgijas, Spanijas, Portugales)
        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
            komisija_calc = Komisija
        End If
        '(ASV)
        If klienta_nr = 12 And (Left(ISIN, 2) = "US") Then
            Komisija = Summa * 0.002
        End If
        '(Lielbritanijas)
        If klienta_nr = 12 And (Left(ISIN, 2) = "UK") Then
            Komisija = Summa * 0.002
            komisija_calc = Komisija
        End If
        '(Šveices)
        If klienta_nr = 12 And (Left(ISIN, 2) = "CH") Then
            Komisija = Summa * 0.002
            komisija_calc = Komisija
        End If
        'Set 20 [valute] MIN
        If klienta_nr = 12 And Komisija <= 20 Then
            komisija_calc = 20
        End If


    Case 13
        '(Ziemelvastu, Lietuvas, Igaunijas, Vacijas, Francijas, Niderlandes, Italijas, Irijas, Austijas, Belgijas, Spanijas, Portugales)
        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
            komisija_calc = Komisija
        End If
        '(ASV)
        If klienta_nr = 13 And (Left(ISIN, 2) = "US") Then
            Komisija = Summa * 0.002
            komisija_calc = Komisija
        End If
        '(Lielbritanijas)
        If klienta_nr = 13 And (Left(ISIN, 2) = "UK") Then
            Komisija = Summa * 0.002
            komisija_calc = Komisija
        End If
        '(Šveices)
        If klienta_nr = 13 And (Left(ISIN, 2) = "CH") Then
            Komisija = Summa * 0.002
            komisija_calc = Komisija
        End If
        'Set 20 [valute] MIN
        If klienta_nr = 13 And Komisija <= 20 Then
            komisija_calc = 20
        End If


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



        'Non-special klient cases
    Case Else
        If Not Application.Match(klienta_nr, ClientNumbers) Then
            'IP2, 0.03% komisija, 40 EUR/USD Max
            If Right(Vk, 1) = 1 Or Right(Vk, 1) = 8 Then
                Komisija = Summa * 0.003
                komisija_calc = Komisija
            End If
            'IP1, 0.1% komisija, 40 EUR/USD Max
            If Right(Vk, 1) = 7 Then
                Komisija = Summa * 0.01
                komisija_calc = Komisija
            End If
            'Komisija MAX is 40, so anything >=40 equals 40
            If Komisija >= 40 Then
                komisija_calc = 40
            End If
        End If
    End Select
End Function
jkpieterse
  • 2,727
  • 1
  • 9
  • 18