Excel VBA error with sum formula

brightwayhr

New Member
Joined
Oct 5, 2016
Messages
10
Hi All,

I have an spreadsheet which consist of employee data and there revenue to generate an automate invoice.

here is an image link

https://1drv.ms/i/s!AnOR9mvtWzlzc6NUs4vHUtxOI5c

M21 is the total cell which has name range as Total
M22 is the StTax as name range.

The grand total has to be M21:24

The error is Grand Total is not including M23 and M24 as the formula which is applied in M22 cell was Total-StTax as named range.
However I tried recording macro its not working out can anyone edit my below vba code as per formula and share the proper code.

M21 is Total amount of M
M22 is 14% from Total
M23 is 0.5% from Total
M24 is 0.5% from Total
Grand Total = M21:M24



Rich (BB code):
Rich (BB code):
OptionExplicit
Sub GetEmployeData()
Dim WI As Worksheet, WR As Worksheet
Dim i AsLong, j AsLong, l AsLong, m AsLong, n AsLong, p AsLong, q AsLong
Dim FRowR As Long, FRowI As Long
Dim INV AsString, TINV AsString
Dim Tax AsDouble, Amount AsDouble, Sum AsDouble
Dim AINW


'Setting Worksheet Variables
Set WI = Sheet1
Set WR = Sheet10


FRowR = WR.Cells(Rows.Count, 16).End(xlUp).Row
p = 1
INV = InputBox("Enter the Invoice No. of the Employee you want to add.", "Invoice No.", "BWC/139")
INV = Trim(Replace(INV, " ", ""))
Application.ScreenUpdating = False


For i = 2 To FRowR
    TINV = WR.Range("P" & i).Text
    TINV = Trim(Replace(TINV, " ", ""))



    If TINV = INV And TINV <> "" Then


    j = 20
    If WI.Range("B" & j) <> "" Then
        p = 20
        WI.Rows("20:20").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            WI.Range("B" & j) = WR.Range("B" & i) 'EMP ID
            WI.Range("C" & j) = WR.Range("C" & i) 'CNDT NAME
            WI.Range("E" & j) = WR.Range("D" & i) 'Telephone NO.
            WI.Range("M" & j) = WR.Range("I" & i) 'Inv Amount
            WI.Range("G" & j) = WR.Range("F" & i) 'Date of Joining
            WI.Range("I" & j) = WR.Range("G" & i) 'Program
            WI.Range("K" & j) = WR.Range("H" & i) 'Category

Else
        p = 20
        WI.Rows("20:20").Select
        Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
            WI.Range("B" & j) = WR.Range("B" & i) 'EMP ID
            WI.Range("C" & j) = WR.Range("C" & i) 'CNDT NAME
            WI.Range("E" & j) = WR.Range("D" & i) 'Telephone NO.
            WI.Range("M" & j) = WR.Range("I" & i) 'Inv Amount
            WI.Range("G" & j) = WR.Range("F" & i) 'Date of Joining
            WI.Range("I" & j) = WR.Range("G" & i) 'Program
            WI.Range("K" & j) = WR.Range("H" & i) 'Category
EndIf

Else: EndIf

Next i


If p = 20 Then
i = 20
Sum = 0
Do While IsFormula(WI.Range("M" & i)) <> True
    Sum = WI.Range("M" & i).Value + Sum
    i = i + 1
Loop


WI.Range("StTax") = Sum * 0.14
WI.Range("Total") = Sum * 0.14 + Sum
AINW = SpellNumber(WI.Range("Total").Value)
AINW = Replace(AINW, "Dollars", "Rupees")
AINW = Replace(AINW, "Cents", "Paise")
AINW = Replace(AINW, "  ", " ")
WI.Range("AmtW") = AINW
WI.Range("K13") = INV




'For Borders------------------------------


    WI.Range("B20:M20").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith

    WI.Range("B19:M19").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
EndWith

WI.Activate
'----------------------------------------------------------------------
MsgBox "Process Completed"


Else
    MsgBox "No Records found based on this " & INV & " Invoice Number Please Check"
EndIf


WI.Calculate
WI.Range("O24").Select
Application.ScreenUpdating = True
EndSub




Function SpellNumber(ByVal MyNumber)
    Dim Dollars, Cents, Temp
    Dim DecimalPlace, Count
    ReDim Place(9) As String
    Place(2) = " Thousand "
    Place(3) = " Million "
    Place(4) = " Billion "
    Place(5) = " Trillion "
' String representation of amount.
    MyNumber = Trim(Str(MyNumber))
' Position of decimal place 0 if none.
    DecimalPlace = InStr(MyNumber, ".")
' Convert cents and set MyNumber to dollar amount.
    If DecimalPlace > 0 Then
        Cents = GetTens(Left(Mid(MyNumber, DecimalPlace + 1) & _
                  "00", 2))
        MyNumber = Trim(Left(MyNumber, DecimalPlace - 1))
EndIf
    Count = 1
    Do While MyNumber <> ""
        Temp = GetHundreds(Right(MyNumber, 3))
        If Temp <> "" Then Dollars = Temp & Place(Count) & Dollars
        If Len(MyNumber) > 3 Then
            MyNumber = Left(MyNumber, Len(MyNumber) - 3)
        Else
            MyNumber = ""
        End If
        Count = Count + 1
Loop
    Select Case Dollars
        Case ""
            Dollars = "No Dollars"
        Case "One"
            Dollars = "One Dollar"
         Case Else
            Dollars = Dollars & " Dollars"
EndSelect
    Select Case Cents
        Case ""
            Cents = " and No Cents"
        Case "One"
            Cents = " and One Cent"
              Case Else
            Cents = " and " & Cents & " Cents"
EndSelect
    SpellNumber = Dollars & Cents
EndFunction

' Converts a number from 100-999 into text
Function GetHundreds(ByVal MyNumber)
    Dim Result As String
    If Val(MyNumber) = 0 Then Exit Function
    MyNumber = Right("000" & MyNumber, 3)
' Convert the hundreds place.
    If Mid(MyNumber, 1, 1) <> "0" Then
        Result = GetDigit(Mid(MyNumber, 1, 1)) & " Hundred "
EndIf
' Convert the tens and ones place.
    If Mid(MyNumber, 2, 1) <> "0" Then
        Result = Result & GetTens(Mid(MyNumber, 2))
Else
        Result = Result & GetDigit(Mid(MyNumber, 3))
EndIf
    GetHundreds = Result
EndFunction

' Converts a number from 10 to 99 into text.
Function GetTens(TensText)
    Dim Result As String
    Result = ""           ' Null out the temporary function value.
    If Val(Left(TensText, 1)) = 1 Then   ' If value between 10-19...
        Select Case Val(TensText)
            Case 10: Result = "Ten"
            Case 11: Result = "Eleven"
            Case 12: Result = "Twelve"
            Case 13: Result = "Thirteen"
            Case 14: Result = "Fourteen"
            Case 15: Result = "Fifteen"
            Case 16: Result = "Sixteen"
            Case 17: Result = "Seventeen"
            Case 18: Result = "Eighteen"
            Case 19: Result = "Nineteen"
            Case Else
EndSelect
    Else                                 ' If value between 20-99...
        Select Case Val(Left(TensText, 1))
            Case 2: Result = "Twenty "
            Case 3: Result = "Thirty "
            Case 4: Result = "Forty "
            Case 5: Result = "Fifty "
            Case 6: Result = "Sixty "
            Case 7: Result = "Seventy "
            Case 8: Result = "Eighty "
            Case 9: Result = "Ninety "
            Case Else
EndSelect
        Result = Result & GetDigit _
            (Right(TensText, 1))  ' Retrieve ones place.
EndIf
    GetTens = Result
EndFunction

' Converts a number from 1 to 9 into text.
Function GetDigit(Digit)
    Select Case Val(Digit)
        Case 1: GetDigit = "One"
        Case 2: GetDigit = "Two"
        Case 3: GetDigit = "Three"
        Case 4: GetDigit = "Four"
        Case 5: GetDigit = "Five"
        Case 6: GetDigit = "Six"
        Case 7: GetDigit = "Seven"
        Case 8: GetDigit = "Eight"
        Case 9: GetDigit = "Nine"
        Case Else: GetDigit = ""
EndSelect
EndFunction

Function IsFormula(cell_ref As Range)
    IsFormula = cell_ref.HasFormula
EndFunction

 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

Forum statistics

Threads
1,214,827
Messages
6,121,817
Members
449,049
Latest member
cybersurfer5000

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top