I have what I think is a relatively simple function I'm running where I'm basically trying to find how much time someone stays waiting in the queue for a call back. It runs great when I'm in the VBA tab, but when I call the function in my spreadsheet I get a #REF! error.
Function TIQ2()
Dim time, count, i As Integer
Dim TIQ
time = 0
count = 0
NumRows = Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)).Rows.count + 1
For i = 2 To NumRows
If Sheet1.Range("c" & i) = "no" Or Sheet1.Range("c" & i) = "No" Then
If Sheet1.Range("d" & i) = "No" Or Sheet1.Range("d" & i) = "no" Then
time = time + Left(Sheet1.Range("g" & i), 2)
count = count + 1
Debug.Print time, count
End If
End If
Next
TIQ2 = WorksheetFunction.RoundUp(time / count, 0) & " minutes"
Debug.Print TIQ2
End Function
try changing this line. some excel function requieres this syntaxis
TIQ2 = WorksheetFunction.RoundUp(time / count, 0) & " minutes"
'-------------------
TIQ2 =ThisWorkbook.Application.WorksheetFunction.RoundUp(time / count, 0) & " minutes"
Option Explicit
'Public Function fnHelloWorld()
'Function fnTIQ()
Function TIQ2()
MsgBox "Hello World!"
End Function
Sub Test()
Call TIQ2
End Sub
Try this ...
The first two function declarations work OK but the third one does not. The #REF error is produced by the fact that the TIQ2 function name is also a cell reference as #EvR says.
Related
is there a way to handle an error in a loop
I use a match function to match a cottage with the right size and class as it is reserved. But if there is no cottage_size available, the match function returns an error, after which I want to upgrade the cottage(cottage_size=cottage_size+1) and search for a match again..
My question is how do i go back to the match function after the error and after I upgraded the size..
If som = 0 And iDklasse = class And iDpers = cottage_size Then
Set klasseKolom = cottagesheet.UsedRange.Columns(3)
Set SizeKolom = cottagesheet.UsedRange.Columns(2)
For k = 4 To 1 Step -1
For p = 2 To 12
cottageId = (Evaluate("MATCH(1,(" & klasseKolom.Address(External:=True) & "=" & zoekklasse & ")*(" & SizeKolom.Address(External:=True) & "=" & cottage_size & "),0)"))
If Not IsError(cottageId) Then
huisnr = cottageId
If Application.CountIf(validatorsheet.Range("B:B"), huisnr) = 0 Then 'cottage beschikbaarheid (gaat niet goed)
validatorsheet.Cells(iD, 2).Value = cottagesheet.Cells(cottageId, 1).Value 'invullen in validatorsheet
stay = Reservationsheet.Cells(iD, 3).Value
arrival_date = Reservationsheet.Cells(iD, 2).Value
For datumkolom = 2 To laatstekolom
If arrival_date = roostersheet.Cells(1, datumkolom).Value Then
'If Application.CountBlank(Range(roostersheet.Cells(huisnr, datumkolom), roostersheet.Cells(huisnr, datumkolom + stay - 1))) = Range(roostersheet.Cells(huisnr, datumkolom), roostersheet.Cells(huisnr, datumkolom + stay - 1)).Cells.Count Then
Range(roostersheet.Cells(huisnr, datumkolom), roostersheet.Cells(huisnr, datumkolom + stay - 1)).Value = Reservationsheet.Cells(iD, 1).Value
End If
'End If
Next datumkolom
End If
ElseIf IsError(cottageId) Then zoekklasse = zoekklasse + k And cottage_size = cottage_size + p And klasseKolom = klasseKolom + k And SizeKolom = SizeKolom + p
cottageId = (Evaluate("MATCH(1,(" & klasseKolom.Address(External:=True) & "=" & zoekklasse & ")*(" & SizeKolom.Address(External:=True) & "=" & cottage_size & "),0)"))
huisnr = cottageId 'indien er geen match is??
End If
Next p
Next k
thanks in advance
Normally to run worksheet functions you would use the WorksheetFunction API.
Early-bound, Application.WorksheetFunction.Match gives you compile-time validation and idiomatic VBA runtime errors in case of mismatch (i.e. you can handle a mismatch with an On Error statement).
Late-bound, Application.Match loses compile-time validation, but now you get a Variant/Error result instead of a VBA runtime error in case of mismatch.
Using the late-bound version, you would have to validate that the result is usable before you consume it. The IsError standard library function returns true given a Variant/Error argument, so here:
If IfError(cottageId) Then
'...
End If
Try changing it to:
If IsError(cottageId) Then
'...
End If
That makes your control flow look something like this:
For i = 1 To iterations
Dim result As Variant
result = Evaluate("complicated Excel formula string")
If Not IsError(result) Then
'TODO process valid result here
Exit For 'we're done, no need to keep looping
End If
Next
Consider heeding Darren's advice though: it does seem Range.Find could be a better tool here. Loop logic remains the same: last thing you want is to GoTo-jump and increment i until the counter overflows its data type - with a For loop you can cap the maximum number of attempts beyond which you just gotta admit that you didn't get a match for the given cottage_size; Range.Find/Range.FindNext have mechanisms that kind of already implement this for you.
I am trying to use the code below, however I don't understand why it is printing out a blank message box? Additionally, there is only one for each day, and it is saying there is 2 files?
How do I print these back effectively, second, how do I then use that to open the sheet?
The files are written as samadmin15112018_??????.csv Where the question marks are a time stamp which I don't know.
Sub runFA()
Const yourfilepath = "R:\samsdrive\sam\test\"
Dim s As String
Dim x As Integer
Dim v() As String
s = Dir(yourfilepath & "samadmin" & format(Sheets("Name").Range("C3"), "yyyymmdd") & "_*.csv")
v = Split(vbNullString)
Do Until s = ""
x = x + 1
ReDim Preserve v(x + 1)
s = Dir()
Loop
If UBound(v) > 0 Then
MsgBox "There are " & UBound(v) & " workbooks", vbOKOnly
MsgBox v(x + 1)
Else
If v(0) <> "" Then Workbooks.Open (yourfilepath & v(0))
MsgBox ("There are 0 ")
End If
End Sub
Fixing the previous answer...
You were getting an empty element because the original code resized the array for the first element, which meant that v(0) was always going to be vbNullString. With string arrays, you can take advantage of the Split function's behavior of returning an array with a UBound of -1 and an LBound of 0 if you're going to add elements to it dynamically:
Sub runFA()
Const targetPath = "R:\samsdrive\sam\test\"
Dim located() As String
located = Split(vbNullString)
Dim result As String
result = Dir$(targetPath & "samadmin" & Format$(Sheets("Name").Range("C3"), "yyyymmdd") & "_*.csv")
Do Until result = vbNullString
ReDim Preserve located(UBound(located) + 1)
located(UBound(located)) = result
result = Dir$()
Loop
If UBound(located) <> 0 Then
MsgBox "There are " & (UBound(located) + 1) & " workbooks", vbOKOnly
Else
Workbooks.Open targetPath & result
End If
End Sub
A couple other things to note
I changed the variable names from single letter identifiers to something a little easier to read and understand.
The indentation is now consistant.
It uses the string typed functions for Dir and Format.
You don't need to track the count of results with x at all.
If you only have one element in the results array, you can simply use result - there isn't any reason to index back into the array.
I have a userform with textboxes txtTF1 – txtTF30 where odd numbers are a start date and even numbers are end dates. I’m using a calendar date picker and a (correctly functioning) logical test to help ensure the inputs are dates. I also want a logical test on the inputs to make sure I don’t have overlapping dates.
The code below correctly spots date overlap until it runs into textboxes that are intentionally left blank. Those blanks are set to vbnullstring when the form initializes. At this point something triggers the message box saying there is an overlap on the next to last set of dates even when I can see that is not true.
Debug.Print is showing that the last set of dates in the userform is not loading into the variables.
I’m not sure where/how this test breaks down. Any thoughts?
Sub OverlapCheck
Dim i as Long
Dim CheckDate1
Dim CheckDate2
Dim CheckDate3
For i = 2 To 28 Step 2
CheckDate1 = Controls("txtTF" & i).value
CheckDate2 = Controls("txtTF" & (i + 1)).value
CheckDate3 = Controls("txtTF" & (i - 1)).value
‘stop test if next date is blank
If Not IsDate(CheckDate2) Then Exit For
‘if a valid date range is entered then check to see if the next date is an overlap
If IsDate(CheckDate1) And IsDate(CheckDate3) Then
If CheckDate1 >= CheckDate2 Then
MsgBox ("Dates " & CheckDate1 & " and" & CheckDate2 & " overlap"), vbOKOnly
frmRLVL.Show
End If
End If
Next
End Sub
I got this to work with the addition of CDate() in the for/next statement. I'm still not sure why this makes it work on the last set of dates when input data ends where 2>i>28. At this point I'm calling it a win.
For i = 2 To 28 Step 2
CheckDate1 = Controls("txtTF" & i).value
CheckDate2 = Controls("txtTF" & (i - 1)).value
CheckDate3 = Controls("txtTF" & (i + 1)).value
If Not IsDate(CheckDate3) Then Exit For
If IsDate(CheckDate1) And IsDate(CheckDate2) Then
CheckDate1 = CDate(CheckDate1)
CheckDate2 = CDate(CheckDate2)
CheckDate3 = CDate(CheckDate3)
If CheckDate1 >= CheckDate3 Then
MsgBox ("Dates " & CheckDate1 & " and" & CheckDate3 & " overlap"), vbOKOnly
frmRLVL.Show
End If
End If
Next
1. I was trying to answer VBA UDF to split string array and got an unpleasant results during computing my UDF.
Public Function mytest(src, dest)
dest.Parent.Evaluate "test(" & src.Address(False, False) & ", " & dest.Address(False, False) & ")"
mytest = "wut"
End Function
Sub test(src As Range, dest As Range)
Dim chr, rows, cols
rows = 0
cols = 0
For chr = 1 To Len(src.Value)
Select Case Mid(src.Value, chr, 1)
Case ","
rows = rows + 1
Case ";"
cols = cols + 1
rows = 0
Case Else
Cells(dest.Row + rows, dest.Column + cols).Value = Cells(dest.Row + rows, dest.Column + cols).Value & Mid(src.Value, chr, 1) '
End Select
Next chr
End Sub
Expected results:
Formula results:
Can someone explain why does it double Value of the cell?
When I debugged test using
Sub ffs()
Call test(Cells(1, 1), Cells(3, 1))
End Sub
I got expected results, so I guess the problem is not in the test Sub?..
2. Whenever I try to add more parameters to Function and Sub (for example delimiters) Function doesn't Evaluate Sub at all
Public Function CellToRange(src, dest, DelimL, DelimC)
dest.Parent.Evaluate "test(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", " & DelimL & ", " & DelimC & ")"
CellToRange = "wut"
End Function
Sub CTR(src As Range, dest As Range, Delim1, Delim2)
Dim chr, rows, cols
rows = 0
cols = 0
For chr = 1 To Len(src.Value)
Select Case Mid(src.Value, chr, 1)
Case Delim1
rows = rows + 1
Case Delim2
cols = cols + 1
rows = 0
Case Else
Cells(dest.Row + rows, dest.Column + cols).Value = Cells(dest.Row + rows, dest.Column + cols).Value & Mid(src.Value, chr, 1) '
End Select
Next chr
End Sub
Please help ._. and thanks in advance.
Solution:
Thanks Billy and Charles Williams.
Change
dest.Parent.Evaluate "CTR(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", " & DelimL & ", " & DelimC & ")"
To
dest.Parent.Evaluate "0+CTR(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", " & DelimL & ", " & DelimC & ")"
Thanks everyone!
The problem lies with the Worksheet.Evaluate method which is being used to get round the restriction that a UDF is not allowed to modify the worksheet structure.
Consider this code
Option Explicit
Public Function dummyudf() As String
Debug.Print "Calling Evaluate method"
ActiveSheet.Evaluate "testsub()"
Debug.Print "Returning From Evaluate method"
dummyudf = "done"
End Function
Sub testsub()
Debug.Print "testsub running"
End Sub
Sub testmacro()
Dim s As String
Debug.Print "testmacro running"
s = dummyudf
End Sub
The UDF dummyudf() uses the Evaluate method to invoke the Sub called testsub(). These are analagous to mytest and test in part 1. of the OP and to CellToRange and CTR in part 2 but are stripped down to the bare minimum.
testsub() can also be invoked directly as a macro. A second macro testmacro invokes dummyudf as a function in VBA.
The following output was obtained from the Immediate Window:
As can be seen
when invoked as a macro: testsub() behaves as expected
when dummyudf() is invoked as a UDF on the worksheet (for example by adding the formula =dummyudf() to cell A1 the Evaluate method appears to call testsub() twice
when dummyudf() is invoked as a function in VBA by running testmacro() as a macro the Evaluate method appears to call testsub() twice.
The documentation here suggests that the Name argument of the Worksheet.Evaluate method should be the name of an object, so it is a bit surprising that it is possible supply the name of a Sub. That it also seems to call any such Sub twice, is even more surprising but does underline the advice given in YowE3K's answer about not using this hack in a UDF. I'd go further: don't use Worksheet.Evaluate with any Sub.
1) It evaluates once when the formula is triggered, and again when cell A3 is updated by the function (as it is one of the cells the formula is dependent on).
2a) You are calling the wrong subroutine (test instead of CTR)
2b) You need to call your second function using something like
=CellToRange(A1;A3;""",""";""";""")
or else change the line in your code calling CTR to be
dest.Parent.Evaluate "CTR(" & src.Address(False, False) & ", " & dest.Address(False, False) & ", """ & DelimL & """, """ & DelimC & """)"
3) I strongly recommend that you do not use this sort of hack to get a UDF to update cells other than the one containing the function.
I need to maintain a count of replacements made before implementing the Worksheets(...).Columns(...).Replace function using Excel VBA.
Can anyone guide me regarding code that I probably need to insert in *** below for counting the replacements that are about to occur in the next line of code? Thanks.
Function Value_Replace(TabName As String, ColumnTitle As String, val_Old As String, val_New As String)
Dim MyColumn, CountReplacements As Long
Dim MyColumnLetter As String
MyColumn = WorksheetFunction.Match(ColumnTitle, ActiveWorkbook.Sheets(TabName).Range("1:1"), 0)
'CountReplacements = ***?
Worksheets(TabName).Columns(MyColumnLetter).Replace _
what:=val_Old, Replacement:=val_New, _
SearchOrder:=xlByColumns, MatchCase:=False
Value_Replace = "Values " & CountReplacements & " in column " & MyColumnLetter & " updated!"
End Function
I propose to store in the cell (eg [A1]) and the number of repetitions for each call to change to increment it. But it must be the end of all calculations to clear the cell that would be the next time you call this function, the function would not start incrementing the previous value.
Some will look like this:
[A1].value = [A1].value + 1
CountReplacements = [A1].value
How about using COUNTIF with * Old_Str *? You don't need to count the actual replacements before they happen, just find out how many occurrences of Old_Str there are in your column within the contents of each cell before you start the replacement. Doing it on New_Str after you'd replaced it would be unwise unless you could guarantee there were no occurrences of New-Str before you executed the replacement .
CountReplacements = WorksheetFunction.CountIf(ActiveSheet.Columns(MyColumnLetter), "*" & val_Old & "*")
Give it a go and see
Thanks. But this worked as well:
While Not ConsecutiveEmpty = 1
If IsEmpty(Worksheets("Sheet1").Cells(LastRow, 2).Value) Then
ConsecutiveEmpty = ConsecutiveEmpty + 1
End If
LastRow = LastRow + 1
Wend
MyCount = 0
For i = 2 To LastRow
If Worksheets("Sheet1").Cells(i, MyColumn).Value = val_Old Then
MyCount = MyCount + 1
End If
Next