I'm trying to use "And" & "Or" within an If statement. I probably have my syntax wrong.
the result comes back false when the data should make it true. Here is the code:
ElseIf (origNum = "006260006" Or origNum = "30062600006") And creditOrDebit = "D" Then
'do things here
End If
-When I debug and come to this line it hops over it and doesn't enter in.
-origNum actually equals "006260006" and creditOrDebit = "D".
-so I'm assuming my "Or" statement isn't working.
-Hopefully this is a quick easy question. Thanks!
The problem is probably somewhere else. Try this code for example:
Sub test()
origNum = "006260006"
creditOrDebit = "D"
If (origNum = "006260006" Or origNum = "30062600006") And creditOrDebit = "D" Then
MsgBox "OK"
End If
End Sub
And you will see that your Or works as expected. Are you sure that your ElseIf statement is executed (it will not be executed if any of the if/elseif before is true)?
This is not an answer, but too long for a comment.
In reply to JP's answers / comments, I have run the following test to compare the performance of the 2 methods. The Profiler object is a custom class - but in summary, it uses a kernel32 function which is fairly accurate (Private Declare Sub GetLocalTime Lib "kernel32" (lpSystemTime As SYSTEMTIME)).
Sub test()
Dim origNum As String
Dim creditOrDebit As String
Dim b As Boolean
Dim p As Profiler
Dim i As Long
Set p = New_Profiler
origNum = "30062600006"
creditOrDebit = "D"
p.startTimer ("nested_ifs")
For i = 1 To 1000000
If creditOrDebit = "D" Then
If origNum = "006260006" Then
b = True
ElseIf origNum = "30062600006" Then
b = True
End If
End If
Next i
p.stopTimer ("nested_ifs")
p.startTimer ("or_and")
For i = 1 To 1000000
If (origNum = "006260006" Or origNum = "30062600006") And creditOrDebit = "D" Then
b = True
End If
Next i
p.stopTimer ("or_and")
p.printReport
End Sub
The results of 5 runs (in ms for 1m loops):
20-Jun-2012 19:28:25
nested_ifs (x1): 156 - Last Run: 156 - Average Run: 156
or_and (x1): 125 - Last Run: 125 - Average Run: 125
20-Jun-2012 19:28:26
nested_ifs (x1): 156 - Last Run: 156 - Average Run: 156
or_and (x1): 125 - Last Run: 125 - Average Run: 125
20-Jun-2012 19:28:27
nested_ifs (x1): 140 - Last Run: 140 - Average Run: 140
or_and (x1): 125 - Last Run: 125 - Average Run: 125
20-Jun-2012 19:28:28
nested_ifs (x1): 140 - Last Run: 140 - Average Run: 140
or_and (x1): 141 - Last Run: 141 - Average Run: 141
20-Jun-2012 19:28:29
nested_ifs (x1): 156 - Last Run: 156 - Average Run: 156
or_and (x1): 125 - Last Run: 125 - Average Run: 125
Note
If creditOrDebit is not "D", JP's code runs faster (around 60ms vs. 125ms for the or/and code).
I like assylias' answer, however I would refactor it as follows:
Sub test()
Dim origNum As String
Dim creditOrDebit As String
origNum = "30062600006"
creditOrDebit = "D"
If creditOrDebit = "D" Then
If origNum = "006260006" Then
MsgBox "OK"
ElseIf origNum = "30062600006" Then
MsgBox "OK"
End If
End If
End Sub
This might save you some CPU cycles since if creditOrDebit is <> "D" there is no point in checking the value of origNum.
Update:
I used the following procedure to test my theory that my procedure is faster:
Public Declare Function timeGetTime Lib "winmm.dll" () As Long
Sub DoTests2()
Dim startTime1 As Long
Dim endTime1 As Long
Dim startTime2 As Long
Dim endTime2 As Long
Dim i As Long
Dim msg As String
Const numberOfLoops As Long = 10000
Const origNum As String = "006260006"
Const creditOrDebit As String = "D"
startTime1 = timeGetTime
For i = 1 To numberOfLoops
If creditOrDebit = "D" Then
If origNum = "006260006" Then
' do something here
Debug.Print "OK"
ElseIf origNum = "30062600006" Then
' do something here
Debug.Print "OK"
End If
End If
Next i
endTime1 = timeGetTime
startTime2 = timeGetTime
For i = 1 To numberOfLoops
If (origNum = "006260006" Or origNum = "30062600006") And _
creditOrDebit = "D" Then
' do something here
Debug.Print "OK"
End If
Next i
endTime2 = timeGetTime
msg = "number of iterations: " & numberOfLoops & vbNewLine
msg = msg & "JP proc: " & Format$((endTime1 - startTime1), "#,###") & _
" ms" & vbNewLine
msg = msg & "assylias proc: " & Format$((endTime2 - startTime2), "#,###") & _
" ms"
MsgBox msg
End Sub
I must have a slow computer because 1,000,000 iterations took nowhere near ~200 ms as with assylias' test. I had to limit the iterations to 10,000 -- hey, I have other things to do :)
After running the above procedure 10 times, my procedure is faster only 20% of the time. However, when it is slower it is only superficially slower. As assylias pointed out, however, when creditOrDebit is <>"D", my procedure is at least twice as fast. I was able to reasonably test it at 100 million iterations.
And that is why I refactored it - to short-circuit the logic so that origNum doesn't need to be evaluated when creditOrDebit <> "D".
At this point, the rest depends on the OP's spreadsheet. If creditOrDebit is likely to equal D, then use assylias' procedure, because it will usually run faster. But if creditOrDebit has a wide range of possible values, and D is not any more likely to be the target value, my procedure will leverage that to prevent needlessly evaluating the other variable.
Related
I'm working on a VBA project to determine if PE of a company is too high. I'm relatively inexperienced with vba, however, I cannot find anything wrong with my code, why does excel always return me an object required error? If anyone could help me, thank you!
Dim i As Long, pe As Long
Dim result As String
For i = 4 To 10
pe = Sheet1.Range("C" & i).Value
If pe >= 85 Then
result = "high"
ElseIf pe >= 75 Then
result = "mid"
ElseIf pe >= 55 Then
result = "low"
ElseIf pe >= 40 Then
result = "very low"
Else
result = "not in range"
End If
Sheet1.Range("D" & i).Value = result
Next
End Sub
Even though it's the wrong stack exchange, you need to add a declaration at the start to dim Sheet1 as Sheet or similar, i think it's complaining that it doesn't know what Sheet1 is at runtime.
Let's say I have the following values:
1 min 7 sec
23 sec
6 hours 10 min 14 sec
I want to return:
7 sec
23 sec
14 sec
Is there a way to do this in VBA?
Sec, Min, or Hours may not always be present if a value for it is not used.
I.e. if there are 60 seconds, it will just say 1 min. If there are 60 minutes exactly, it will just say 1 hour.
Here is a method using regular expressions. It looks for a number-space-sec and returns a hyphen if not found. Amend to suit.
Code amended to incorporate #Mathieu Guindon's suggestion. + looks for one or more instances, * for zero or more.
Function Regex1(v As Variant) As String
With CreateObject("vbscript.regexp")
.Global = True
.Pattern = "\d+\s*sec"
If .Test(v) Then
Regex1 = .Execute(v)(0)
Else
Regex1 = "-"
End If
End With
End Function
Function POP(strInput As String) As String
Dim a() As String
a = Split(strInput, " ")
If UBound(a) > 0 Then
POP = a(UBound(a) - 1) & " " & a(UBound(a))
Else
POP = a(UBound(a))
End If
Erase a
End Function
I need to round time to the nearest quarter hour in a word document. I am not very good at coding.
After a fair bit of searching I have found some vba code but it doesn't quite work. The code is:
Sub Time()
Dim num() As String
Dim tod() As String
Dim temp As String
num = Split(Time, ":")
tod = Split(num(2), " ")
If Val(num(1)) < 15 Then
temp = "00"
ElseIf Val(num(1)) < 30 Then
temp = "15"
ElseIf Val(num(1)) < 45 Then
temp = "30"
ElseIf Val(num(1)) < 60 Then
temp = "45"
End If
gettime = num(0) + ":" + temp + ":00 " + tod(1)
End Function
End Sub
When I try to run it I get a message:
"Compile Error: Expected function or variable"
and "Time" on the fifth line of the code is highlighted which I think is where the program stops running.
The rest of the code in the form is as follows:
This module doesn't affect the time rounding issue but I am including it so as not to leave anything out.
Option Explicit
Sub ClusterCheck()
Dim i As Integer, k As Integer, iCluster As Integer, bResult As Boolean
Dim sFieldNameNo As String, sName As String
On Error Resume Next ' If the first formfield is a checkbox, this will bypass the error that Word returns
sName = Selection.FormFields(1).Name ' Get the name of the formfield
bResult = ActiveDocument.FormFields(sName).CheckBox.Value ' Get the result of the current formfield
sFieldNameNo = Number(sName) ' Get generic number
sName = Left(sName, Len(sName) - Len(sFieldNameNo)) ' Get generic name
' Determine how many fields are within the cluster group
iCluster = 1
Do Until ActiveDocument.Bookmarks.Exists(sName & iCluster) = False
iCluster = iCluster + 1
Loop
iCluster = iCluster - 1
' If the check field is true, turn all of the other check fields to false
Application.ScreenUpdating = False
If bResult = True Then
For k = 1 To iCluster
If k <> sFieldNameNo Then ActiveDocument.FormFields(sName & k).Result = False
Next
End If
Application.ScreenUpdating = True
End Sub
This is the Number module:
Option Explicit
Function Number(ByVal sNumber As String) As String
' This module finds the form fields number within the field name
' Loops through the field name until it only has the number
Do Until IsNumeric(sNumber) = True Or sNumber = ""
sNumber = Right(sNumber, Len(sNumber) - 1)
Loop
Number = sNumber
End Function
This is the protection module:
Option Explicit
Sub Protect()
ActiveDocument.Protect Password:="wup13", NoReset:=True, Type:=wdAllowOnlyFormFields
End Sub
Sub Unprotect()
ActiveDocument.Unprotect Password:="wup13"
End Sub
This is the code that activates on opening and closing the document:
Option Explicit
Sub Document_Open()
' Zooms to page width, turns on Hidden Text, and turns off ShowAll and Table Gridlines
With ActiveWindow.View
.Zoom.PageFit = wdPageFitBestFit
.ShowHiddenText = True
.TableGridlines = False
.ShowAll = False
End With
Options.UpdateFieldsAtPrint = False
End Sub
Sub Document_Close()
' Turn on ShowAll and Table Gridlines
With ActiveWindow.View
.ShowAll = True
.TableGridlines = True
End With
Options.UpdateFieldsAtPrint = True
End Sub
That's all the code in the form. I am not great at VBA but am hoping I can solve this issue (with a little help).
DETAILS OF EXTRA DUTY FORM
Persons details
Family name:
Given name(s):
Level:
No.:
Location:
Cost Centre Code:
Time worked
Were any days of the extra duty performed on a designated public/show holiday? Yes 0 No 0
If yes enter holiday date/details:
Time commenced: [Text Form Field]
Date:
Time ceased: [Text Form Field]
Date:
Total Overtime claimed:
Are you a shift worker? Yes 0 No 0
Details of extra duty performed:
Vehicle details
Car: Yes 0 No 0
Motorcycle: Yes 0 No 0
Registration no.:
Fleet no.:
Stationary vehicle hours:
Yes 0 No 0 (only use for stationary duties)
Vehicle odometer start:
Odometer finish:
Total kms:
Client’s details
Company/Organisation name:
Phone no.:
Contact name:
Job no.:
Payment for special services
Was payment received in advance? Yes 0 No 0
If Yes– Amount:
Receipt no.:
Date:
If No– Amount:
Invoice no.:
Date:
I, , certify the above information to be true
(Signature) (Date)
Manager certification (Checked with roster and certified correct)
(Signature) (Date)
The code from vbforums gives me a subscript out of range error when used as recommended.
In the VBA IDE you can get explanations of what keywords do by placing the cursor on a keyword and pressing F1. This will bring up the MS help page for that particular keyword.
In the OP code the main procedure is 'Time'. This will cause problems for VBA because this is the same as the Time keyword so we would effectively be saying
time(time)
and VBA will stop with an error because the second use of time will be interpreted as the sub time and not the VBA time function so you will get the error message 'Argument not optional'.
The code below will provide what the OP has requested.
Option Explicit
Sub test_gettime()
Dim myTime As String
myTime = Now()
Debug.Print myTime
Debug.Print Format(myTime, "hh:mm:ss")
Debug.Print gettime(Format(myTime, "hh:mm:ss"))
' without the format statement we should also get the date
myTime = Now()
Debug.Print
Debug.Print myTime
Debug.Print gettime(myTime)
End Sub
Public Function gettime(this_time As String) As String
Dim myTimeArray() As String
Dim myQuarterHour As String
myTimeArray = Split(this_time, ":")
' Note that myTimeArray has not been converted to numbers
' Comparison of strings works by comparing the ascii values of each character
' in turn until the requested logic is satisfied
Select Case myTimeArray(1)
Case Is < "15"
myQuarterHour = "00"
Case Is < "30"
myQuarterHour = "15"
Case Is < "45"
myQuarterHour = "30"
Case Is < "60"
myQuarterHour = "45"
Case Else
Debug.Print "More than 60 minutes in the hour??"
End Select
gettime = myTimeArray(0) + ":" + myQuarterHour + ":00 "
End Function
So I get e-mails every day with information in them. Unfortunately, for some reason, the data is sent in the body of the e-mail, and not as an attachment. Fine then. I'm using Excel to scrape Outlook, using VBA.
Sub mytry()
Dim olapp As Object
Dim olmapi As Object
Dim olmail As Object
Dim olitem As Object
Dim lrow As Integer
Dim olattach As Object
Dim str As String
Dim TextWeNeedToParse as String
Const num As Integer = 6
Const path As String = "C:\HP\"
Const emailpath As String = "C:\Dell\"
Const olFolderInbox As Integer = 6
Set olp = CreateObject("outlook.application")
Set olmapi = olp.getnamespace("MAPI")
Set olmail = olmapi.getdefaultfolder(num)
If olmail.items.restrict("[ReceivedTime]>=""&MacroDate&12:00am&""").Count = 0 Then
Else
For Each olitem In olmail.items.restrict("[ReceivedTime]>=""&MacroDate&12:00am&""")
TextWeNeedToParse = olitem.body
'Recursive text parsing here
Next olitem
End If
Ok, so this code snippet should get me the entire body of the text into a string. Now we can pass the string around, and manipulate it.
A sample of the text I'm dealing with:
WAL +300bp QTY
(M) FCTR SECURITY CPN ASK 1mPSA TYPE
0.77 1.15 458 0.04 GNR 2012-61 CA 2.00 99-16 217 SEQ
1.39 2.26 120 0.76 GNR 2005-13 AE 5.00 102-24 223 SUP
1.40 18.16 45 0.65 GNR 2015-157 NH 2.50 95-16 215 EXCH,+
1.50 21.56 25 0.94 GNR 2017-103 HD 3.00 98-08 375 PAC-2
So there are a few different ways I can see myself tackling this, but I don't quite know all of the pieces.
1) I could try counting how many carriage returns exist, and doing a loop. Then "counting" spaces to figure out where everything is. Not quite sure how well it would work.
2) I could regex out the unique ID in the middle, and if I can figure out how to regex the nth instance (a major point where I'm stuck), I could also use that to regex out the numbers - for example, line one would be the 1-5 instance of straight numbers/decimals together surrounded by spaces, and the first instance of number-number-dash-number-number.
Sample Regex Code that I'd throw through it:
Function regex(strInput As String, matchPattern As String, Optional ByVal outputPattern As String = "$0") As Variant
Dim inputRegexObj As New VBScript_RegExp_55.RegExp, outputRegexObj As New VBScript_RegExp_55.RegExp, outReplaceRegexObj As New VBScript_RegExp_55.RegExp
Dim inputMatches As Object, replaceMatches As Object, replaceMatch As Object
Dim replaceNumber As Integer
With inputRegexObj
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = matchPattern
End With
With outputRegexObj
.Global = True
.MultiLine = True
.IgnoreCase = False
.Pattern = "\$(\d+)"
End With
With outReplaceRegexObj
.Global = True
.MultiLine = True
.IgnoreCase = False
End With
Set inputMatches = inputRegexObj.Execute(strInput)
If inputMatches.Count = 0 Then
regex = False
Else
Set replaceMatches = outputRegexObj.Execute(outputPattern)
For Each replaceMatch In replaceMatches
replaceNumber = replaceMatch.SubMatches(0)
outReplaceRegexObj.Pattern = "\$" & replaceNumber
If replaceNumber = 0 Then
outputPattern = outReplaceRegexObj.Replace(outputPattern, inputMatches(0).Value)
Else
If replaceNumber > inputMatches(0).SubMatches.Count Then
'regex = "A to high $ tag found. Largest allowed is $" & inputMatches(0).SubMatches.Count & "."
regex = CVErr(xlErrValue)
Exit Function
Else
outputPattern = outReplaceRegexObj.Replace(outputPattern, inputMatches(0).SubMatches(replaceNumber - 1))
End If
End If
Next
regex = outputPattern
End If
End Function
3) I could try some of the methods above, but use recursion. My recursion is fairly weak.
So once I have the text string extracted, I imagine I'd need something like:
Sub QuickExample(Dim Cusip as String, Dim PriceStr as variant, Dim SpreadStr as variant)
Dim ws as WorkSheet
Set ws = thisworkbook.sheets("Results")
LastRow = ws.Cells(sht.Rows.Count, "A").End(xlUp).Row
ws.cells(Lastrow,1).value2 = Cusip
ws.cells(Lastrow,2).value2 = PriceStr
ws.cells(Lastrow,3).value2 = SpreadStr
End Sub
And lastly:
Sub ParsingDate(EmailText as String)
Dim CarriageReturns As Long
CarriageReturns = Len(EmailText) - Len(Replace(EmailText, Chr(10), ""))
For i = 1 to CarriageReturns
'Parse out the data for the ith row, return it to the function above
Next i
End Sub
It's the actual act of parsing which I'm struggling a bit with - how do I properly get the nth result, and only the nth result? How do I make sure it keeps working even if some extra spaces or lines get added? Is there a way to just use regex, and "look" around the nth finding of a given expression? Is it doable to make this without a lot of recursion?
Thank you
WAL +300bp QTY
(M) FCTR SECURITY CPN ASK 1mPSA TYPE
0.77 1.15 458 0.04 GNR 2012-61 CA 2.00 99-16 217 SEQ
1.39 2.26 120 0.76 GNR 2005-13 AE 5.00 102-24 223 SUP
1.40 18.16 45 0.65 GNR 2015-157 NH 2.50 95-16 215 EXCH,+
1.50 21.56 25 0.94 GNR 2017-103 HD 3.00 98-08 375 PAC-2
This seems like a pretty well formatted table. Perhaps pop each line into an array using Split() and then each field into an array, again using split():
Sub dump()
arrLine = Split(TextWeNeedToParse, Chr(10))
For Each Line In arrLine
For Each field In Split(Line, " ")
Debug.Print field
Next
Next
End Sub
That's super short and runs quick. You are just an if statement and counter (or regex test) away from getting the exact items you want.
Testing/counting may be easier if you remove multiple spaces so the split() puts each element in it's proper place. You could employee a loop to remove multiple spaces before running this:
Fully implemented it might be something like:
<your code to get the bod>
'remove multiple spaces from string for parsing
Do While InStr(1, TextWeNeedToParse, " ")
TextWeNeedToParse= Replace(TextWeNeedToParse, " ", " ")
Loop
'Get each line into an array element
arrLine = Split(TextWeNeedToParse, Chr(10))
'Loop through the array
For Each Line In arrLine
'dump fields to an array
arrFields = Split(Line, " ")
'and spit out a particular element (your "unique id" is element 5)
If UBound(arrFields) >= 5 Then Debug.Print "unique id:"; arrFields(5)
Next
I have a workbook that takes more than 6 seconds to open due to a number of macros that run within the workbook_open event.
I want to speed this up so I have used a timer to test different parts of the code at startup vs being run while the workbook is open. All of the parts take the same time to run in both situations, except this part:
Dim ATime As Double
Dim BTime As Double
ATime = timer
Dim b As Long
For b = 5 To 268
If Sheets("Orders").Range("F" & b) = "Locked" Then
Sheets("Orders").Range("C" & b).Locked = True
Sheets("Orders").Range("D" & b).Locked = True
Sheets("Orders").Range("E" & b).Locked = True
End If
Next
BTime = timer
MsgBox "1. " & Format(BTime - ATime, "0.00 \s\ec")
When run at workbook_open: 2.78 seconds. When run manually within workbook: 0.01 seconds.
What is the problem here?
Try:
With Sheets("Orders")
For b = 5 To 268
.Range("C" & b).Resize(1, 3).Locked = (.Range("F" & b) = "Locked")
Next
End With