VBA to calculate tip credits for employees

[rjr1040]

I would like to have vba set up to do the following. Col M1(tips) is the entry column where it will have a number or not.
Col N1 will calculate a 5% tip credit on the amount in M1 and if blank in M1, will be blank in N1.
If M1 has a number then O1 will subtract the number (%) in N1 from the number in M1 and put it in this cell, if M1 is blank then this will be blank also.
P1 is the same as whatever is in M1
Q1 will ask the operator to provide $amount to be manually entered into cell V1
R1 is the percentage calculated with Q1's percentage of P1 (may be positive or negative)
S1 is the difference in percentage from 5% which the amount over/under in R1 minus 5%

The only cell that will require an entry in this entire table is M1 and the it will do a lookup or find the amount in Q1 from another calculation (V1)
I would like for this to calculate automatically as soon as the entry in M1 and a valid entry is located in Q1 for up to 100 rows
M1 N1 O1 P1 Q1 R1 S1

$ 300.00

$ 15.00

$ 285.00

$ 300.00

$ 17.38

5.79%

[td width="66pt"]

-0.79%​

[/td]​

$ blank

$ -

$ -

$ -

$ -

-

[td width="66pt"]

-​

[/td]​

Hope this is clear and I have one other problem
for Each entry in M1 I would like to have an increasing number, starting from 1 and counting the number of Cells in M1 that have a numerical entry and skip the blank entries giving me a total in W1.

Am I dreaming or can this be done, I have minimal skills at vba, almost non existent. Thank you in advance.

 

[shamimarita]

Hello Rjr,

Yes, this can definitely be done with VBA and Worksheet Change events. You actually have two separate tasks:

1. Perform automatic calculations in columns N:S whenever a value is entered in column M.
2. Maintain a running sequential count for rows where column M contains a numeric value.

A Worksheet_Change event in the sheet module would be the best approach because it updates automatically as soon as data is entered.

Something along these lines should work:

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim c As Range
    Dim lastRow As Long
    Dim cnt As Long

    If Intersect(Target, Range("M:M")) Is Nothing Then Exit Sub

    Application.EnableEvents = False

    lastRow = 100

    For Each c In Range("M1:M" & lastRow)

        If IsNumeric(c.Value) And c.Value <> "" Then

            ' N = 5% tip credit
            c.Offset(0, 1).Value = c.Value * 0.05

            ' O = M - N
            c.Offset(0, 2).Value = c.Value - c.Offset(0, 1).Value

            ' P = same as M
            c.Offset(0, 3).Value = c.Value

            ' Q would come from your lookup/result
            ' Example:
            ' c.Offset(0, 4).Value = WorksheetFunction.VLookup(...)

            ' R = percentage of Q vs P
            If c.Offset(0, 3).Value <> 0 Then
                c.Offset(0, 5).Value = c.Offset(0, 4).Value / c.Offset(0, 3).Value
            End If

            ' S = difference from 5%
            c.Offset(0, 6).Value = c.Offset(0, 5).Value - 0.05

        Else

            Range(c.Offset(0, 1), c.Offset(0, 6)).ClearContents

        End If

    Next c

    ' Running count of numeric entries in column M
    cnt = Application.WorksheetFunction.Count(Range("M1:M" & lastRow))

    Range("W1").Value = cnt

    Application.EnableEvents = True

End Sub

You are definitely not dreaming; this is very achievable in VBA. The only part still needing clarification is how column Q/V gets its lookup value. Once you explain where that value comes from (table, formula, another sheet, etc.), the lookup portion can also be automated.