I am getting a compile error in Excel VBA which says Expected Sub, Function or Property. The function I am using is given below which is trying to copy the rate function in Excel.
Thanks for your help.
Function rate_m(nper As Double, pmt As Double, pv As Double, fv As Double, types As Double, guess As Double) As Variant
Dim y, y0, y1, x0, x1, f, i As Double
Dim FINANCIAL_MAX_ITERATIONS As Double
Dim FINANCIAL_PRECISION As Double
If IsNull(guess) Then guess = 0.01
If IsNull(fv) Then fv = 0
If IsNull(types) Then types = 0
FINANCIAL_MAX_ITERATIONS = 128 'Bet accuracy with 128
FINANCIAL_PRECISION = 0.0000001 '1.0e-8
y , y0, y1, x0, x1, f, i = 0
rate_m = guess
If Abs(rate_m) < FINANCIAL_PRECISION Then
y = pv * (1 + nper * rate_m) + pmt * (1 + rate_m * types) * nper + fv
Else
f = Exp(nper * Log(1 + rate_m))
y = pv * f + pmt * (1 / rate_m + types) * (f - 1) + fv
y0 = pv + pmt * nper + fv
y1 = pv * f + pmt * (1 / rate_m + types) * (f - 1) + fv
End If
'find root by Newton secant method
i , x0 = 0
x1 = rate_m
While Abs(y0 - y1) > FINANCIAL_PRECISION & i < FINANCIAL_MAX_ITERATIONS
rate_m = (y1 * x0 - y0 * x1) / (y1 - y0)
x0 = x1
x1 = rate_m
If Abs(rate_m) < FINANCIAL_PRECISION Then
y = pv * (1 + nper * rate_m) + pmt * (1 + rate_m * types) * nper + fv
Else
f = Exp(nper * Log(1 + rate_m))
y = pv * f + pmt * (1 / rate_m + types) * (f - 1) + fv
End If
y0 = y1
y1 = y
i = i + 1
Wend
End Function
Permalink
Cannot retrieve contributors at this time
title | keywords | f1_keywords | ms.prod | ms.assetid | ms.date | ms.localizationpriority |
---|---|---|---|---|---|---|
Expected Sub, Function, or Property |
vblr6.chm1011162 |
vblr6.chm1011162 |
office |
cb6d9b37-d190-dd46-cba4-ea6f9c6b7f3d |
06/08/2017 |
medium |
The syntax of your statement indicates a Sub, Function, or Property procedure invocation. This error has the following cause and solution:
-
The specified name isn’t that of a Sub, Function, or Property procedure in scope in this part of your program.
Check the spelling of the name. Note that if the procedure is defined as Private, it can only be called from within its module.
For additional information, select the item in question and press F1 (in Windows) or HELP (on the Macintosh).
[!includeSupport and feedback]
Function GetPingResult(Host)
Dim objPing As Object
Dim objStatus As Object
Dim strResult As String
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}"). _
ExecQuery("Select * from Win32_PingStatus Where Address = '" & Host & "'")
For Each objStatus In objPing
Select Case objStatus.StatusCode
Case 0: strResult = "Connected"
Case 11001: strResult = "Buffer too small"
Case 11002: strResult = "Destination net unreachable"
Case 11003: strResult = "Destination host unreachable"
Case 11004: strResult = "Destination protocol unreachable"
Case 11005: strResult = "Destination port unreachable"
Case 11006: strResult = "No resources"
Case 11007: strResult = "Bad option"
Case 11008: strResult = "Hardware error"
Case 11009: strResult = "Packet too big"
Case 11010: strResult = "Request timed out"
Case 11011: strResult = "Bad request"
Case 11012: strResult = "Bad route"
Case 11013: strResult = "Time-To-Live (TTL) expired transit"
Case 11014: strResult = "Time-To-Live (TTL) expired reassembly"
Case 11015: strResult = "Parameter problem"
Case 11016: strResult = "Source quench"
Case 11017: strResult = "Option too big"
Case 11018: strResult = "Bad destination"
Case 11032: strResult = "Negotiating IPSEC"
Case 11050: strResult = "General failure"
Case Else: strResult = "Unknown host"
End Select
GetPingResult = strResult
Next
Set objPing = Nothing
End Function
Sub GetIPStatus()
Dim Cell As Range
Dim ipRng As Range
Dim Result As String
Dim Wks As Worksheet
Set Wks = Worksheets("Sheet1")
Set ipRng = Wks.Range("A2")
Set RngEnd = Wks.Cells(Rows.Count, ipRng.Column).End(xlUp)
Set ipRng = IIf(RngEnd.Row < ipRng.Row, ipRng, Wks.Range(ipRng, RngEnd))
For Each Cell In ipRng
If Cell.Value <> "" Then
Result = GetPingResult(Cell)
Cell.Offset(0, 1) = Result
Else
Cell.Offset(0, 1) = "No IP specified!"
End If
Next Cell
End Sub
Private Sub Clear_Contents_Click()
Range("A2:B10000").Select
Selection.ClearContents
Range("A2").Select
End Sub
Private Sub DNSLookup_Click()
Range("C2:C10000").Select
Selection.ClearContents
Range("A2").Select
For x = 2 To Sheets("Sheet1").Range("A10000").End(xlUp).Row
Dim IPAddy As String
Dim LookupResult As String
IPAddy = Sheets("Sheet1").Cells(x, 1).Value
LookupResult = NSLookup(IPAddy, 0)
Sheets("Sheet1").Cells(x, 3) = LookupResult
Next x
End Sub
Private Sub Ping_Click()
Range("B2:C10000").Select
Selection.ClearContents
Range("A2").Select
GetIPStatus
End Sub
Public Function NSLookup(lookupVal As String, Optional addressOpt As Integer) As String
Const ADDRESS_LOOKUP = 1
Const NAME_LOOKUP = 2
Const AUTO_DETECT = 0
'Skip everything if the field is blank
If lookupVal <> "" Then
Dim oFSO As Object, oShell As Object, oTempFile As Object
Dim sLine As String, sFilename As String
Dim intFound As Integer
Set oFSO = CreateObject("Scripting.FileSystemObject")
Set oShell = CreateObject("Wscript.Shell")
'Handle the addresOpt operand
'Regular Expressions are used to complete a substring match for an IP Address
'If an IP Address is found, a DNS Name Lookup will be forced
If addressOpt = AUTO_DETECT Then
ipLookup = FindIP(lookupVal)
If ipLookup = "" Then
addressOpt = ADDRESS_LOOKUP
Else
addressOpt = NAME_LOOKUP
lookupVal = ipLookup
End If
'Do a regular expression substring match for an IP Address
ElseIf addressOpt = NAME_LOOKUP Then
lookupVal = FindIP(lookupVal)
End If
'Run the nslookup command
sFilename = oFSO.GetTempName
oShell.Run "cmd /c nslookup " & lookupVal & " > " & sFilename, 0, True
Set oTempFile = oFSO.OpenTextFile(sFilename, 1)
Do While oTempFile.AtEndOfStream <> True
sLine = oTempFile.Readline
cmdStr = cmdStr & Trim(sLine) & vbCrLf
Loop
oTempFile.Close
oFSO.DeleteFile (sFilename)
'Process the result
intFound = InStr(1, cmdStr, "Name:", vbTextCompare)
If intFound = 0 Then
NSLookup = ""
Exit Function
ElseIf intFound > 0 Then
'TODO: Cleanup with RegEx
If addressOpt = ADDRESS_LOOKUP Then
loc1 = InStr(intFound, cmdStr, "Address:", vbTextCompare) + InStr(intFound, cmdStr, "Addresses:", vbTextCompare)
loc2 = InStr(loc1, cmdStr, vbCrLf, vbTextCompare)
nameStr = Trim(Mid(cmdStr, loc1 + 8, loc2 - loc1 - 8))
ElseIf addressOpt = NAME_LOOKUP Then
loc1 = InStr(intFound, cmdStr, "Name:", vbTextCompare)
loc2 = InStr(loc1, cmdStr, vbCrLf, vbTextCompare)
nameStr = Trim(Mid(cmdStr, loc1 + 5, loc2 - loc1 - 5))
End If
End If
NSLookup = nameStr
Else
NSLookup = "N/A"
End If
End Function
Public Function FindIP(strTest As String) As String
Dim RegEx As Object
Dim valid As Boolean
Dim Matches As Object
Dim i As Integer
Set RegEx = CreateObject("VBScript.RegExp")
RegEx.Pattern = "b(?:d{1,3}.){3}d{1,3}b"
valid = RegEx.test(strTest)
If valid Then
Set Matches = RegEx.Execute(strTest)
FindIP = Matches(0)
Else
FindIP = ""
End If
End Function
Фазли 2 / 1 / 0 Регистрация: 07.10.2018 Сообщений: 172 |
|||||||||
1 |
|||||||||
02.12.2018, 07:17. Показов 3609. Ответов 1 Метки нет (Все метки)
0 |
1838 / 1154 / 353 Регистрация: 11.07.2014 Сообщений: 4,083 |
|
02.12.2018, 08:00 |
2 |
Решение
j -j + 1 думаю, должно быть j = j+1
1 |
-
- #1
I am relatively new to coding in VBA and keep getting the compile error and cannot figure out why it keeps coming up. Any help on quelling the pop up would be helpful.
Here is the code where I keep getting the error:
Sub tax() Tester = 0 livePriceTotal = Cells(lastLiveRow + 1, 2) liveTaxTotal = Cells(lastLiveRow + 1, 3) silentPriceTotal = Cells(lastSilentRow + 1, 7) silentTaxTotal = Cells(lastSilentRow + 1, 8) taxRate = Range("G1").Value taxExempt = Range("G2") taxRateAdj = ((liveTaxTotal + silentTaxTotal) * (100)) / (livePriceTotal + silentPriceTotal - taxExempt) Do If liveTaxTotal + silentTaxTotal = (livePriceTotal + silentPriceTotal - taxExempt) * taxRate Then Tester = 1 'Cells(1, 8) = taxRateAdj If liveTaxTotal + silentTaxTotal <= (livePriceTotal + silentPriceTotal - taxExempt) * taxRate Then Tester = 2 'ActiveCell(1, 8) = taxRateAdj If liveTaxTotal + silentTaxTotal > (livePriceTotal + silentPriceTotal - taxExempt) * taxRate Then Tester = 3 If Tester = 1 Then taxRate If Tester = 2 Then taxRate If Tester = 3 Then taxRateAdj End Sub
Display More
-
- #2
Re: Compile Error Expected Sub, Function, or Property
You have a «Do» statement but no concluding Loop. Either conclude the loop or remove the Do.
-
- #3
Re: Compile Error Expected Sub, Function, or Property
Removed the «Do» statement.
Still getting the same error this time the highlighted term is «taxRate»
Did I not declare taxRate correctly? -
- #4
Re: Compile Error Expected Sub, Function, or Property
Hello vtflee,
Welcome to Ozgrid.
You should never code without using Option Explicit. It forces you to properly declare your variables.
Turn on Option Explicit while in the VB Editor: Menu > Tools > Options > check the box for Require Variable DeclarationUnless you haven’t posted all of your code, none of your variable are declared.
I don’t see where you have defined «lastliverow» or «lastSilentrow».Correct your variable delcarations, then your loop structure, then step through the code.
Correct/Efficient Uses of Excel Loops
-
- #5
Re: Compile Error Expected Sub, Function, or Property
Thanks.
I did declare it in the beginning but did not include it in my previous code. I added it right after the sub tax and ran it again, but still getting the same error and it stops at taxRate again.
Here’s the code again:
Sub tax() Dim livePriceTotal As Currency Dim liveTaxTotal As Currency Dim silentPriceTotal As Currency Dim silentTaxTotal As Currency Dim taxRate As Long Dim taxCorrect As Long Dim taxExempt As Currency Dim taxRateAdj As Long Tester = 0 livePriceTotal = Cells(lastLiveRow + 1, 2) liveTaxTotal = Cells(lastLiveRow + 1, 3) silentPriceTotal = Cells(lastSilentRow + 1, 7) silentTaxTotal = Cells(lastSilentRow + 1, 8) taxRate = Range("G1").Value taxExempt = Range("G2") taxRateAdj = ((liveTaxTotal + silentTaxTotal) * (100)) / (livePriceTotal + silentPriceTotal - taxExempt) If liveTaxTotal + silentTaxTotal = (livePriceTotal + silentPriceTotal - taxExempt) * taxRate Then Tester = 1 'Cells(1, 8) = taxRateAdj If liveTaxTotal + silentTaxTotal <= (livePriceTotal + silentPriceTotal - taxExempt) * taxRate Then Tester = 2 'ActiveCell(1, 8) = taxRateAdj If liveTaxTotal + silentTaxTotal > (livePriceTotal + silentPriceTotal - taxExempt) * taxRate Then Tester = 3 If Tester = 1 Then taxRate If Tester = 2 Then taxRate If Tester = 3 Then taxRateAdj End Sub
Display More
-
- #6
Re: Compile Error Expected Sub, Function, or Property
Where do you define lastLiveRow? What is in G1?
-
- #7
Re: Compile Error Expected Sub, Function, or Property
G1 is a tax rate. That value is being pulled from another spreadsheet. I used a vlookup function in the G1 cell.
-
- #8
Re: Compile Error Expected Sub, Function, or Property
Post a workbook.
-
- #9
Re: Compile Error Expected Sub, Function, or Property
The other workbook where the tax rates are being pulled is too big to post. Hope that’s not an issue.
-
- #10
Re: Compile Error Expected Sub, Function, or Property
Hard to tell but if you declare something as Long it covers integers so if you have something 0.08 you need to declare as Double. Somewhat mystified by the error message you were getting though. I get an overflow error on the taxrateadj line.
-
- #11
Re: Compile Error Expected Sub, Function, or Property
Yes. Another one of the many problems I am having. I changed taxRate to double, but still getting the same error. Right now I am only debugging the sub tax section. Would I have to fix the overflow problem first?
-
- #12
Re: Compile Error Expected Sub, Function, or Property
I don’t understand why you are getting that error, that is not related to overflow afaik (that is because division by zero, but that may only be because of the lack of links when I ran it). Are you running exactly the same code? Have you stepped through the code using F8?