I am having a problem running the code below, the code is to calculate the difference between two array of dates, values is separted by line carriage (CHR(10)), for example in cell A1 I have the following dates
A1
12/12/2012
11/12/2021
7/8/2015
9/4/2014
B1
12/12/2012
11/12/2021
7/8/2015
9/4/2014
C1
2D
1D
4D
10D
in D1 I call the function from which is inside module 1 as following
=calcSumDurations(A1,B1,C1)
it will always return 0
and when I try to trace the code, it will enter the for loop only once, even than intmax = 3, or 4 or 40 in some cases, I tried while, for, foreach, none working.
Function calcSumDurations(dateFrom, dateTo, dateDuration As String)
Dim intmax, intSum, i, intError As Integer
Dim varDateFrom, varDateTo, varDateDuration As Variant
intSum = 0
intmax = -1
i = 0
intError = 0
varDateFrom = Split(dateFrom, Chr(10))
varDateTo = Split(dateTo, Chr(10))
varDateDuration = Split(dateDuration, Chr(10))
intmax = UBound(varDateFrom)
If UBound(varDateFrom) = UBound(varDateTo) Then ' both are same lenght
If intmax >= 0 Then ' more than one line
For i = 0 To intmax
'While i < intmax
MsgBox (i)
If CInt(CDate(varDateTo(i))) >= CDate(varDateFrom(i)) Then 'check dates are more
If testDate(CStr(varDateTo(i))) And testDate(CStr(varDateFrom(i))) Then
intDuration = Abs(CInt(CDate(varDateTo(i)) - CDate(varDateFrom(i)))) + 1
intSum = intSum + intDuration
'strRes = strRes & CStr(intDuration) & Chr(10)
Else
intError = 1
'Exit For
End If
Else
intError = 2
End If
Next i
End If
Else
intError = 3
End If
calcSumDurations = intSum
End Function
The problem is in this line of code:
If CInt(CDate(varDateTo(i))) >= CDate(varDateFrom(i)) Then
an integer is too small to hold the date value and is causing an overflow exception. I'm not sure why you're trying to convert it into an integer anyways as the comparison won't work if you do that.
Try this:
If CDate(varDateTo(i)) >= CDate(varDateFrom(i)) Then
It'll at least start getting through the loop.
I'd also define what you want the function to return
Function calcSumDurations(dateFrom As String, dateTo As String, dateDuration As String) As Long
Related
For Example,
I'd like a String such as, "This is a Bunch of Words in a sequence of 13 possible 1 words from a Dictionary or BookZZ or Libgen.io 1876" to give me a result of 19 (because "13", "1876" and "1" are numbers and should not be counted).
I created Two Functions which I'm trying to use within this Function I'm asking about:
The first one is the following:
' NthWord prints out the Nth Word of a String of Text in an Excel Cell such
' as A1 or B19.
Function NthWord(ActiveCell As String, N As Integer)
Dim X As String
X = ActiveCell
X = Trim(Mid(Replace(ActiveCell, " ", Application.WorksheetFunction.Rept("
", Len(ActiveCell))), (N - 1) * Len(ActiveCell) + 1, Len(ActiveCell)))
NthWord = X
' In the Excel SpreadSheet:
' Trim (Mid(Substitute(A1, " ", Rept(" ", Len(A1))), (N - 1) * Len(A1)
' + 1, Len(A1)))
End Function
The second one is the following:
'NumberOfWords returns the number of words in a String
Function NumberOfWords(ActiveCell As String)
Dim X As String
X = ActiveCell
Dim i As Integer
i = 0
If Len(Trim(X)) = 0 Then
i = 0
Else:
i = Len(Trim(X)) - Len(Replace(X, " ", "")) + 1
End If
NumberOfWords = i
' In the Excel SpreadSheet
' IF(LEN(TRIM(A1))=0,0,LEN(TRIM(A1))-LEN(SUBSTITUTE(A1," ",""))+1)
End Function
My Attempt at printing the NumberOfNonNumberWords
Function NumberOfNonNumberWords(ActiveCell As String)
Dim X As String
X = ActiveCell
Dim count As Integer
count = 0
Dim i As Integer
If NumberOfWords(X) > 0 Then
For i = 1 To NumberOfWords(X)
If Not (IsNumeric(NthWord(X, i).Value)) Then
count = count + 1
End If
Next i
End If
NumberOfNonNumberWords = count
End Function
However, when I apply this function in the Excel Worksheet, I get an output of
#VALUE!
and I'm not sure why. How do I fix this?
Split the whole string then count non-numeric elements.
function abcWords(str as string) as long
dim i as long, arr as variant
arr = split(str, chr(32))
for i=lbound(arr) to ubound(arr)
abcWords = abcWords - int(not isnumeric(arr(i)))
next i
end function
You could just use SPLIT() to split the text on a space delimiter, then count the non-numeric words:
Function num_words(ByVal text As String)
Dim txt_split
txt_split = Split(text, " ")
Dim total_words As Long
total_words = 0
Dim i As Long
For i = LBound(txt_split) To UBound(txt_split)
If Not IsNumeric(txt_split(i)) Then
total_words = total_words + 1
End If
Next i
num_words = total_words
End Function
I have in Column K:
K8 is 6384 i.e. =SUM(J1:J8)
K9 is 2598 i.e. =SUM(J2:J9)
K10 is 12176 i.e =SUM(J3:J10)
:
:
K5488
up to K5488 (No numbers in sequence, all different numbers)
The largest number appearing in K is 1 400 000.
I need in Column M: The prime factors of each number in K
e.g. K8 is 6384 then M8 should be 2,2,2,2,3,7,19
k9 is 2598 then M9 should be 2,3,433 etc.
I found the following code by John Coleman on your site (Mar 28) which tested well, but seeing I have no programming knowledge, I don't know how to modify it to use in my columns K & M setup.
Here's the sample code:
Function Factor(ByVal n As Long, Optional FirstTrial As Long = 2) As String
Dim i As Long
Dim t As Long
Dim limit As Long
Dim rest As String
Dim s As String
If n = 1 Then
Factor = n
Exit Function
End If
limit = Int(Sqr(n))
t = FirstTrial
Do While t <= limit
If n Mod t = 0 Then
rest = Factor(n / t, t)
If rest <> "1" Then
s = t & "," & rest
End If
Factor = s
Exit Function
Else
If t = 2 Then t = 3 Else t = t + 2
End If
Loop
'if we get here:
Factor = n
End Function
Function PrimeOrFactor(n As Long) As String
Dim s As String
s = Factor(n)
If n = 1 Then
PrimeOrFactor = "Neither"
ElseIf (s) = Trim(n) Then
PrimeOrFactor = "Prime"
Else
PrimeOrFactor = s
End If
End Function
Tested like:
Sub test()
Dim i As Long
For i = 1 To 20
Cells(i, 1) = i
Cells(i, 2) = PrimeOrFactor(i)
Next i
End Sub
The function you provided is a udf (user defined function) to be used in your worksheet.
If you put the functions you provided in a normal code module, you can enter the following in your worksheet in M8:
=Factor(K8)
and copy that function down to your desired range.
VBA Newbie here with a basic question I've been struggling to find the answer on:
I'm trying to run a loop in VBA that looks up a string (or word) and if that word is found, a specified letter has to appear in a cell in the column beside it. This works fine when I use a specific cell reference (eg Cells(72, 10)), but as soon as I try to loop it using an index (eg Cells(i, 10), it gives an error 13 - type mismatch.
The 'strings' I'm looking up are outputs (either "Peak" or "Trough") from another macro I wrote as a basic calculation function in excel. Is the error as a result of trying to reference a different data type than the "Cells" function can recognise? Or is there just a better way to run my loop? Following are the macro and my loop.
Function FTrough(tmin2, tmin1, t, tplus1, tplus2)
If t < tmin2 And t < tmin1 And t < tplus1 And t < tplus2 Then
FTrough = "Trough"
Else
FTrough = ""
End If
End Function
And the loop":
Sub Lookup()
Dim i As Integer
Dim j As Integer
Dim c As Integer
c = ActiveWorkbook.Worksheets.Count
For i = 1 To c
For j = 2 To 141
If Worksheets(i).Cells(j, 10) = "Trough" Then
Worksheets(i).Cells(j, 12) = "T"
End If
If Worksheets("Austria").Cells(j, 11) = "Peak" Then
Worksheets("Austria").Cells(j, 12) = "P"
End If
Next j
Next i
End Sub
Any help appreciated
I cannot comment because my reput is lower than 50, so here is my answer.
Basically your code works perfectly. I tested it with Excel 2013/VB6 as follows:
Sub Lookup()
Dim i As Integer
Dim j As Integer
Dim c As Integer
c = ActiveWorkbook.Worksheets.Count
For i = 1 To c
For j = 2 To 141
If Worksheets(i).Cells(j, 1) = "Trough" Then
Worksheets(i).Cells(j, 2) = "T"
End If
If Worksheets("Austria").Cells(j, 1) = "Peak" Then
Worksheets("Austria").Cells(j, 2) = "P"
End If
Next j
Next i
End Sub
The function to write the values in Excel:
Public Function X(tmin2, tmin1, t, tplus1, tplus2)
If t < tmin2 And t < tmin1 And t < tplus1 And t < tplus2 Then
X = "Trough"
Else
X = ""
End If
End Function
The values in excel were created by custom as well as e.g. =X(100;100;1;100;100).
I have an Excel worksheet with some strings in a column. Sometimes all of the entries are the same, and sometimes not:
I wrote a function to pass the range as a parameter:
=Dent_WG(A1:A6)
The VBA function should determine which case is true (all entries = "Al", or at least one entry = "Ag"), then return 0 or 12 respectively:
Function DentWG(WG_Mat As Range) As Single
Dim dat As Variant, rw As Variant, temp As Single
dat = WG_Mat
temp = 0
For rw = LBound(dat, 1) To UBound(dat, 1)
If dat(rw, 1) = "Ag" Then
temp = 12
End If
Next
If temp = 12 Then
DentWG = 12
Else
DentWG = 0
End If
End Function
However, the function always returns 0, even for the 2nd case where "Ag" occurs in the range. I'm sure I'm failing to correctly convert the range into an array or correctly apply the intended logic to that array.
From your question...
The VBA function should determine which case is true (all entries = "Al", or at least one entry = "Ag"), then return 0 or 12 respectively:
This is what you need.
Function DentWG(WG_Mat As Range) As Long
Dim ClCount As Long
ClCount = WG_Mat.Cells.Count
If Application.WorksheetFunction.CountIf(WG_Mat, "Al") = ClCount Then
DentWG = 0
ElseIf Application.WorksheetFunction.CountIf(WG_Mat, "Ag") > 0 Then
DentWG = 12
End If
End Function
The same can be achieved using a formula
=IF(COUNTIF(A1:A6,"Al")=(ROWS(A1:A6)*COLUMNS(A1:A6)),0,IF(COUNTIF(A1:A6,"Ag") > 0,12,""))
In case it will always be 1 Column then you don't need *COLUMNS(A1:A6). This will do.
=IF(COUNTIF(A1:A6,"Al")=ROWS(A1:A6),0,IF(COUNTIF(A1:A6,"Ag") > 0,12,""))
ScreenShot
You don't really need a UDF for this. You could just say:
=IF(COUNTIF(A1:A6,"Ag")>=1,12,0)
This works for me:
Function DentWG(WG_Mat As Range) As Single
Dim result As Single, cl as Range
result = 0
For Each cl In WG_Mat
If cl = "Ag" Then
DentWG = 12
Exit Function
End If
Next cl
DentWG = result
End Function
I'm trying to write a UDF (user-defined function) to create an average for non-numeric data (I'm converting it into numeric form then back again at the end). I can get the UDF to work if I list individual cells; I get a #VALUE! error if I try to refer to a range of cells. There may be a mix of both ranges and individual cells to process.
Any ideas?
The code so far is below.
Function avlvl(ParamArray av() As Variant)
Dim a As Integer
'creates an average ks3 level from data in format "5a"
a = 0
n = 0
total = 0
Do While a < UBound(av()) + 1
'ignore blank or zero cells
If av(a) = 0 Or av(a) = "" Then
a = a + 1
Else
'convert data into numeric value - split into level and sub level
level = Val(Left(av(a), 1))
sl = Right(av(a), 1)
If sl = "c" Then
sublevel = 0
ElseIf sl = "C" Then
sublevel = 0
ElseIf sl = "b" Or sl = "B" Then
sublevel = 1 / 3
ElseIf sl = "a" Or sl = "A" Then
sublevel = 2 / 3
Else
sublevel = 0
End If
'score is numeric value of the data
score = level + sublevel
'total is teh toatl of the cells so far
total = total + score
a = a + 1
n = n + 1
End If
Loop
ave = total / n
'reconvert into format level and sublevel (a,b,c)
averagelevel = Application.WorksheetFunction.RoundDown(ave, 0)
asl = ave - averagelevel
If asl < 0.17 Then
averagesublevel = "c"
ElseIf asl < 0.5 Then
averagesublevel = "b"
ElseIf asl < 0.84 Then
averagesublevel = "a"
ElseIf asl < 1 Then
averagelevel = averagelevel + 1
averagesublevel = "c"
Else
averagesublevel = "c"
End If
avlvl = averagelevel & averagesublevel
End Function
What's going on is that the range is coming in as a single object of type Range, and your code is trying to treat is as though it is coming in as an array.
The best approach would be to create a new array within the body of the function, and then assign the elements in the range to the new array. You need to test for the type of the elements of the ParamArray. If an element is type String, then put it directly in the new array; if an element is type Range, loop through it, assigning its cell values to the new array.
Then you would do your processing on the new array.
The following code provides the machinery to pass in ranges as well as individual cells or values. I've not included your code but have indicated where it would go.
Function avlvl(ParamArray av() As Variant) As Variant
Dim a As Integer
Dim i As Long
Dim avArr()
Dim element As Variant
a = 0
i = 0
Do While a < UBound(av) + 1
If TypeName(av(a)) = "String" Then
avArr(i) = av(a)
i = i + 1
ElseIf TypeName(av(a)) = "Range" Then
For Each element In av(a)
ReDim Preserve avArr(0 To i)
avArr(i) = element
i = i + 1
Next
Else
avlvl = CVErr(xlErrValue)
Exit Function
End If
a = a + 1
Loop
i = 0
Do While i < UBound(avArr) + 1
'...
'now process the elements of avArr()
'...
i = i + 1
Loop
End Function
If you have a disjoint range of cells and you want to pass them to a UDF, one approach is to create a Defined Name and pass it to the UDF as a single argument.