I'm trying to write a VBA code with if the i get an error.
I want the code to check if one of the values ("S925,S936,S926,G") is not on cell 10.
Sub checklist()
Dim x
Dim LineType
NumRows = Cells(Rows.Count, "j").End(xlUp).Row
For x = 2 To NumRows
If LineType = "G" Then
If Not InStr("S925,S936,S926,G", cellsCells(x, 10).Value) Then
cells Cells(x, 52).Interior.Color = rgbCrimson
cells Cells(x, 52).Value = "G"
End If
End If
End If
Next x
End Sub
This won't cause an error but it will cause issues with your program so I'll explain it.
InStr doesn't return a Boolean but the index of the first occurrence of the search string. If the string isn't found it returns 0.
For example InStr("12345", "23") will return 2.
Because everything except 0 is cast as True, something like If Instr(....) Then will perform as expected.
However if you use If Not InStr(....) Then something else can/will happen
If Not InStr("12345", "23") Then
Debug.Print "test evaluated as True!"
End If
this prints test evaluated as True! even though "23" is contained in "12345". This is not because InStr returned False though. We can replace the InStr expression with 2 to better understand:
Debug.Print 2 '2 (duh)
Debug.Print CBool(2) 'True (2 converted to Boolean)
Debug.Print Not 2 '-3
Debug.Print CBool(Not 2) 'True (-2 converted to Boolean)
Wy is Not 2 evaluated as -3? That's because the 2 isn't converted to Boolean before Not is applied but the Not is applied bit-wise to the 2, which means every bit is flipped. So 2 (0010) becomes 1101 which is -3 because the computer uses the two's complement to express negative numbers. (Actually more bits are used for Integer but it works the same.) As -3 is not 0, it will be converted to True. Since Not 0 will also be evaluated as True (0000 will be converted to 1111 which is -1 as two's complement) the expression Not InStr(...) will always be evaluated as True.
This bit-wise behavior isn't noticed when working with Booleans because they are represented as 0000 and 1111 internally. This also becomes apparent like this:
Debug.Print 1 = True 'False
Debug.Print CBool(1) = True 'True
Debug.Print -1 = True 'True
Debug.Print CBool(-1) = True'True
Debug.Print CInt(True) '-1 (True converted to Integer)
As you can see here, the True is converted to an Integer rather than the Integer being converted to a Boolean for the = comparison.
Long explanation, short fix: Use If InStr(...) > 0 Then instead of If InStr(...) Then and If InStr(...) = 0 Then instead of If Not InStr(...) Then.
PS: This can also cause confusing behavior if you combine two InStr tests with And because And will be applied bitwise as well.
Related
I am looking for a solution to validate and highlight my cell in case false.
I tried the most promising solution: Regex. But still can not find the pattern I need.
My latest attempt was this pattern: "[A-Z-0-9_.]" This works only if the cell contains only a symbol and nothing else, if the symbol is part of a string it does not work.
Problem is that it does not catch cells that have an odd character in a string of text: Example C4UNIT| or B$GROUP.
Specification Cell can contain only capital characters and two allowed symbols Dash - and Underbar _
This is my complete code:
Function ValidateCellContent()
Sheets("MTO DATA").Select
Dim RangeToCheck As Range
Dim CellinRangeToCheck As Range
Dim CollNumberFirst As Integer
Dim CollNumberLast As Integer
Dim RowNumberFirst As Integer
Dim RowNumberLast As Integer
'--Start on Column "1" and Row "3"
CollNumberFirst = 1
RowNumberFirst = 3
'--Find last Column used on row "2" (Write OMI Headings)
CollNumberLast = Cells(2, Columns.count).End(xlToLeft).Column
RowNumberLast = Cells(Rows.count, 1).End(xlUp).Row
'--Set value of the used range of cell addresses like: "A3:K85"
Set RangeToCheck = Range(Chr(64 + CollNumberFirst) & RowNumberFirst & ":" & Chr(64 + CollNumberLast) & RowNumberLast)
Debug.Print "Cells used in active Range = " & (Chr(64 + CollNumberFirst) & RowNumberFirst & ":" & Chr(64 + CollNumberLast) & RowNumberLast)
For Each CellinRangeToCheck In RangeToCheck
Debug.Print "CellinRangeToCheck value = " & CellinRangeToCheck
If Len(CellinRangeToCheck.Text) > 0 Then
'--Non Printables (Space,Line Feed,Carriage Return)
If InStr(CellinRangeToCheck, " ") _
Or InStr(CellinRangeToCheck, Chr(10)) > 0 _
Or InStr(CellinRangeToCheck, Chr(13)) > 0 Then
CellinRangeToCheck.Font.Color = vbRed
CellinRangeToCheck.Font.Bold = True
'--Allowed Characters
ElseIf Not CellinRangeToCheck.Text Like "*[A-Z-0-9_.]*" Then
CellinRangeToCheck.Font.Color = vbRed
CellinRangeToCheck.Font.Bold = True
Else
CellinRangeToCheck.Font.Color = vbBlack
CellinRangeToCheck.Font.Bold = False
End If
End If
Next CellinRangeToCheck
End Function
Try this:
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'we want only validate when cell content changed, if whole range is involved (i.e. more than 1 cell) then exit sub
If Target.Cells.Count > 1 Then Exit Sub
'if there is error in a cell, also color it red
If IsError(Target) Then
Target.Interior.ColorIndex = 3
Exit Sub
End If
'validate cell with our function, if cell content is valid, it'll return True
'if it i s not valid, then color cell red
If Not ValidateText(Target.Value) Then
Target.Interior.ColorIndex = 3
End If
End Sub
Function ValidateText(ByVal txt As String) As Boolean
Dim i As Long, char As String
'loop through all characters in string
For i = 1 To Len(txt)
char = Mid(txt, i, 1)
If Not ((Asc(char) >= 65 And Asc(char) <= 90) Or char = "-" Or char = "_") Then
'once we come upon invalid character, we can finish the function with False result
ValidateText = False
Exit Function
End If
Next
ValidateText = True
End Function
I've originally assumed you wanted to use RegEx to solve your problem. As per your comment you instead seem to be using the Like operator.
Like operator
While Like accepts character ranges that may resemble regular expressions, there are many differences and few similarities between the two:
Like uses ! to negate a character range instead of the ^ used in RegEx.
Like does not allow/know quantifiers after the closing bracket ] and thus always matches a single character per pair of brackets []. To match multiple characters you need to add multiple copies of your character range brackets.
Like does not understand advanced concepts like capturing groups or lookahead / lookbehind
probably more differences...
The unavailability of quantifiers leaves Like in a really bad spot for your problem. You always need to have one character range to compare to for each character in your cell's text. As such the only way I can see to make use of the Like operator would be as follows:
Private Function IsTextValid(ByVal stringToValidate As String) As Boolean
Dim CharValidationPattern As String
CharValidationPattern = "[A-Z0-9._-]"
Dim StringValidationPattern As String
StringValidationPattern = RepeatString(CharValidationPattern, Len(stringToValidate))
IsTextValid = stringToValidate Like StringValidationPattern
End Function
Private Function RepeatString(ByVal stringToRepeat As String, ByVal repetitions As Long) As String
Dim Result As String
Dim i As Long
For i = 1 To repetitions
Result = Result & stringToRepeat
Next i
RepeatString = Result
End Function
You can then pass the text you want to check to IsTextValid like that:
If IsTextValid("A.ASDZ-054_93") Then Debug.Print "Hurray, it's valid!"
As per your comment, a small Worksheet_Change event to place into the worksheet module of your respective worksheet. (You will also need to place the above two functions there. Alternatively you can make them public and place them in a standard module.):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ValidationRange As Range
Set ValidationRange = Me.Range("A2:D5")
Dim TargetCell As Range
For Each TargetCell In Target.Cells
' Only work on cells falling into the ValidationRange
If Not Intersect(TargetCell, ValidationRange) Is Nothing Then
If IsTextValid(TargetCell.Text) Then
TargetCell.Font.Color = vbBlack
TargetCell.Font.Bold = False
Else
TargetCell.Font.Color = vbRed
TargetCell.Font.Bold = True
End If
End If
Next TargetCell
End Sub
Regular Expressions
If you want to continue down the RegEx road, try this expression:
[^A-Z0-9_-]+
It will generate a match, whenever a passed-in string contains one or more characters you don't want. All cells with only valid characters should not return a match.
Explanation:
A-Z will match all capital letters,
0-9 will match all numbers,
_- will match underscore and dash symbols.
The preceding ^ will negate the whole character set, meaning the RegEx only matches characters not in the set.
The following + tells the RegEx engine to match one or more characters of the aforementioned set. You only want to match your input, if there is at least one illegal char in there. And if there are more than one, it should still match.
Once in place, adapting the system to changing requirements (different chars considered legal) is as easy as switching out a few characters between the [brackets].
See a live example online.
I'm assuming that in vba the type Boolean is just a 16 bit integer. So why and how does Debug.Print differentiate between the two?
Debug.Print -1 = True
Debug.Print -1
Debug.Print True
Will output:
True
-1
True
Line 1 evaluates to (if -1 equals true) then print true else print false
Line 2 evaluates to print -1 (as you asked)
Line 3 evaluates to print true (as you asked)
-1 is true and 0 is false in VBA
You could also assume that a string is an array of bytes, or that a 16-bit integer is a series of 0's and 1's.
The answer is because VBA as a language provides an abstraction for Boolean values.
That's all there is to it: it knows and defines that True and False are Boolean literals; their respective underlying values are nothing but plumbing to make it work: False maps to 0, and any non-zero value converts to True, with -1 being returned for Boolean-to-numeric conversions.
IOW, this isn't about Debug.Print, it's about VBA's type system.
Boolean variables are stored as 16-bit (2-byte) numbers, but they can only be True or False.
When other numeric types are converted to Boolean values, 0 becomes
False and all other values become True.
When Boolean values are converted to other data types, False becomes 0 and True becomes -1.
On your first Debug.Print you evaluate an expression (-1 = True) which is True.
The second prints an Integer.
The third prints a Boolean.
Boolean Data Type
I have a really long IF AND OR formula that I'm trying to convert to VBA so it's quicker.
=IF(OR(H10<>"GL402",H10<>"GL412",H10<>"GL422",H10<>"GL432",H10<>"GL442",H10<>"GL452",H10<>"GL492",
H10<>"GL480",H10<>"GL370",H10<>"GL380",H10<>"GL710")*AND(OR(D10<>3,D10<>9,D10<>10),E10<>"ASX",
F10<>"AUD"),"F126",(IF(OR(H2="GL402",H2="GL412",H2="GL422",H2="GL432",H2="GL442",H2="GL452",H2="GL492")*
AND(OR(D2<>"3",D2<>"9",D2<>"10"),E2="ASX",F2="AUD"),"D111",.......))
I thought this should look like:
IF range("H10").Value <>""GL402"" or ""GL412"" or ""GL422"" or ""GL432"" or ""GL442"" _
or ""GL452"" or ""GL492"" or ""GL480"" or ""GL370"" or ""GL380"" or ""GL710"" AND _
range("D10").Value <>3 or 9 or 10 and range("E10").Value <>""ASX"" and _
range("F10").Value <>""AUD""
then
range("I10").Value = ""F126""
elseif
Range("H2").Value = ""GL402"" Or ""GL412"" Or ""GL422"" Or ""GL432"" Or ""GL442"" Or ""GL452"" Or ""GL492"" _
And Range("D2").Value <> 3 Or 9 Or 10 And Range("E2").Value = ""ASX"" And Range("F2").Value = ""AUD""
then
Range("I2").Value = ""D111""
elseif
another lengthy conditions with ANDs and ORs
plus I was hoping to loop this so it applies this whole IF formula until the value of cell A (whichever row) is blank.
I sort of know the loop should be
Do .........
next (with something like A1 + 1)
until A1 + 1 = ""
loop
any help appreciated!
The first rule of good code is that it should be clear - easy to read and debug. Only afterwards do you try to make it "fast". Converting your current expression to VBA may give a speed advantage but you still don't meet the first test...
You can make things cleaner with an expression like this (you can put this right in your spreadsheet):
=ISERROR(MATCH(H10,{"GL402","GL412","GL422","GL432","GL442","GL452","GL492","GL480","GL370","GL380","GL710"},0))
This will evaluate to "true" if the the value in H10 does not match any of the values in the array.
When you have a lot of or conditions in parallel, you can basically stop when the first condition is true.
An expression like that can be written in VBA as follows:
Sub test()
Dim matchStrings
Dim match1, match2
matchStrings = Array("GL402", "GL412", "GL422", "GL432", "GL442", "GL452", "GL492", "GL480", "GL370", "GL380", "GL710")
firstPart = Application.Match(Range("H10"), matchStrings, 0)
If IsError(firstPart) Then
MsgBox "no match found"
Else
match1 = true
MsgBox "match found at index " & firstPart
End If
End Sub
You can repeat similar code with other expressions, building match2, match3, etc - then combining with all the And and Or that you would like - for example
If match1 And (match2 Or match3) Then
... do something
Else
... do something else
End If
This won't work as expected:
If x = 1 Or 2 Or 3 Then
MsgBox "x is either 1, 2, or 3"
End If
because 2 and 3 aren't boolean (true/false) conditions (at least not the way you expect them to be).
The proper syntax is:
If x = 1 Or x = 2 Or x = 3 Then
MsgBox "x is either 1, 2, or 3"
End If
This is only a partial answer that nevertheless does address one of the many issues in your code.
I have an array (i), and I want to do some math calculations based on the i value with a Parallel.For().
But the problem is, after running the Parallel.For(), the values on my array are still 0.
This happens when my for is from 0 to 0.
This is my code :
Dim a(10) As Double
Parallel.For(0, 0, Sub(i)
a(i) = i + 2
'There is some calculations based on instead of previous line!
'But anyway, the result will be on a(i).
End Sub)
MessageBox.Show(a(0)) 'This returns 0!
For i As Integer = 0 To 0
a(i) = i + 2
Next
MessageBox.Show(a(0)) 'But this returns 2!
What is the problem?
From Microsoft's documentation
If fromInclusive is greater than or equal to toExclusive, then the method returns immediately without performing any iterations.
Therefore nothing will happen when you use Parallel.For(0,0,etc).
Try Parallel.For(0,1) and see if you get a result.
Your correct code should look like this
Dim a(10) As Double
Parallel.For(0, 1, Sub(i)
a(i) = i + 2
'There is some calculations based on instead of previous line!
'But anyway, the result will be on a(i).
End Sub)
MessageBox.Show(a(0)) '2!
For i As Integer = 0 To 0
a(i) = i + 2
Next
MessageBox.Show(a(0)) '2
How come IsDate("13.50") returns True but IsDate("12.25.2010") returns False?
I got tripped up by this little "feature" recently and wanted to raise awareness of some of the issues surrounding the IsDate function in VB and VBA.
The Simple Case
As you'd expect, IsDate returns True when passed a Date data type and False for all other data types except Strings. For Strings, IsDate returns True or False based on the contents of the string:
IsDate(CDate("1/1/1980")) --> True
IsDate(#12/31/2000#) --> True
IsDate(12/24) --> False '12/24 evaluates to a Double: 0.5'
IsDate("Foo") --> False
IsDate("12/24") --> True
IsDateTime?
IsDate should be more precisely named IsDateTime because it returns True for strings formatted as times:
IsDate("10:55 AM") --> True
IsDate("23:30") --> True 'CDate("23:30") --> 11:30:00 PM'
IsDate("1:30:59") --> True 'CDate("1:30:59") --> 1:30:59 AM'
IsDate("13:55 AM") --> True 'CDate("13:55 AM")--> 1:55:00 PM'
IsDate("13:55 PM") --> True 'CDate("13:55 PM")--> 1:55:00 PM'
Note from the last two examples above that IsDate is not a perfect validator of times.
The Gotcha!
Not only does IsDate accept times, it accepts times in many formats. One of which uses a period (.) as a separator. This leads to some confusion, because the period can be used as a time separator but not a date separator:
IsDate("13.50") --> True 'CDate("13.50") --> 1:50:00 PM'
IsDate("12.25") --> True 'CDate("12.25") --> 12:25:00 PM'
IsDate("12.25.10") --> True 'CDate("12.25.10") --> 12:25:10 PM'
IsDate("12.25.2010")--> False '2010 > 59 (number of seconds in a minute - 1)'
IsDate("24.12") --> False '24 > 23 (number of hours in a day - 1)'
IsDate("0.12") --> True 'CDate("0.12") --> 12:12:00 AM
This can be a problem if you are parsing a string and operating on it based on its apparent type. For example:
Function Bar(Var As Variant)
If IsDate(Var) Then
Bar = "This is a date"
ElseIf IsNumeric(Var) Then
Bar = "This is numeric"
Else
Bar = "This is something else"
End If
End Function
?Bar("12.75") --> This is numeric
?Bar("12.50") --> This is a date
The Workarounds
If you are testing a variant for its underlying data type, you should use TypeName(Var) = "Date" rather than IsDate(Var):
TypeName(#12/25/2010#) --> Date
TypeName("12/25/2010") --> String
Function Bar(Var As Variant)
Select Case TypeName(Var)
Case "Date"
Bar = "This is a date type"
Case "Long", "Double", "Single", "Integer", "Currency", "Decimal", "Byte"
Bar = "This is a numeric type"
Case "String"
Bar = "This is a string type"
Case "Boolean"
Bar = "This is a boolean type"
Case Else
Bar = "This is some other type"
End Select
End Function
?Bar("12.25") --> This is a string type
?Bar(#12/25#) --> This is a date type
?Bar(12.25) --> This is a numeric type
If, however, you are dealing with strings that may be dates or numbers (eg, parsing a text file), you should check if it's a number before checking to see if it's a date:
Function Bar(Var As Variant)
If IsNumeric(Var) Then
Bar = "This is numeric"
ElseIf IsDate(Var) Then
Bar = "This is a date"
Else
Bar = "This is something else"
End If
End Function
?Bar("12.75") --> This is numeric
?Bar("12.50") --> This is numeric
?Bar("12:50") --> This is a date
Even if all you care about is whether it is a date, you should probably make sure it's not a number:
Function Bar(Var As Variant)
If IsDate(Var) And Not IsNumeric(Var) Then
Bar = "This is a date"
Else
Bar = "This is something else"
End If
End Function
?Bar("12:50") --> This is a date
?Bar("12.50") --> This is something else
Peculiarities of CDate
As #Deanna pointed out in the comments below, the behavior of CDate() is unreliable as well. Its results vary based on whether it is passed a string or a number:
?CDate(0.5) --> 12:00:00 PM
?CDate("0.5") --> 12:05:00 AM
Trailing and leading zeroes are significant if a number is passed as a string:
?CDate(".5") --> 12:00:00 PM
?CDate("0.5") --> 12:05:00 AM
?CDate("0.50") --> 12:50:00 AM
?CDate("0.500") --> 12:00:00 PM
The behavior also changes as the decimal part of a string approaches the 60-minute mark:
?CDate("0.59") --> 12:59:00 AM
?CDate("0.60") --> 2:24:00 PM
The bottom line is that if you need to convert strings to date/time you need to be aware of what format you expect them to be in and then re-format them appropriately before relying on CDate() to convert them.
Late to the game here (mwolfe02 answered this a year ago!) but the issue is still real, there are alternative approaches worth investigating, and StackOverflow is the place to find them: so here's my own answer...
I got tripped up by VBA.IsDate() on this very issue a few years ago, and coded up an extended function to cover cases that VBA.IsDate() handles badly. The worst one is that floats and integers return FALSE from IsDate, even though date serials are frequently passed as Doubles (for DateTime) and Long Integers (for dates).
A point to note: your implementation might not require the ability to check array variants. If not, feel free to strip out the code in the indented block that follows Else ' Comment this out if you don't need to check array variants. However, you should be aware that some third-party systems (including realtime market data clients) return their data in arrays, even single data points.
More information is in the code comments.
Here's the Code:
Public Function IsDateEx(TestDate As Variant, Optional LimitPastDays As Long = 7305, Optional LimitFutureDays As Long = 7305, Optional FirstColumnOnly As Boolean = False) As Boolean
'Attribute IsDateEx.VB_Description = "Returns TRUE if TestDate is a date, and is within ± 20 years of the system date.
'Attribute IsDateEx.VB_ProcData.VB_Invoke_Func = "w\n9"
Application.Volatile False
On Error Resume Next
' Returns TRUE if TestDate is a date, and is within ± 20 years of the system date.
' This extends VBA.IsDate(), which returns FALSE for floating-point numbers and integers
' even though the VBA Serial Date is a Double. IsDateEx() returns TRUE for variants that
' can be parsed into string dates, and numeric values with equivalent date serials. All
' values must still be ±20 years from SysDate. Note: locale and language settings affect
' the validity of day- and month names; and partial date strings (eg: '01 January') will
' be parsed with the missing components filled-in with system defaults.
' Optional parameters LimitPastDays/LimitFutureDays vary the default ± 20 years boundary
' Note that an array variant is an acceptable input parameter: IsDateEx will return TRUE
' if all the values in the array are valid dates: set FirstColumnOnly:=TRUE if you only
' need to check the leftmost column of a 2-dimensional array.
' * THIS CODE IS IN THE PUBLIC DOMAIN
' *
' * Author: Nigel Heffernan, May 2005
' * http://excellerando.blogspot.com/
' *
' *
' * *********************************
Dim i As Long
Dim j As Long
Dim k As Long
Dim jStart As Long
Dim jEnd As Long
Dim dateFirst As Date
Dim dateLast As Date
Dim varDate As Variant
dateFirst = VBA.Date - LimitPastDays
dateLast = VBA.Date + LimitFutureDays
IsDateEx = False
If TypeOf TestDate Is Excel.Range Then
TestDate = TestDate.Value2
End If
If VarType(TestDate) < vbArray Then
If IsDate(TestDate) Or IsNumeric(TestDate) Then
If (dateLast > TestDate) And (TestDate > dateFirst) Then
IsDateEx = True
End If
End If
Else ' Comment this out if you don't need to check array variants
k = ArrayDimensions(TestDate)
Select Case k
Case 1
IsDateEx = True
For i = LBound(TestDate) To UBound(TestDate)
If IsDate(TestDate(i)) Or IsNumeric(TestDate(i)) Then
If Not ((dateLast > CVDate(TestDate(i))) And (CVDate(TestDate(i)) > dateFirst)) Then
IsDateEx = False
Exit For
End If
Else
IsDateEx = False
Exit For
End If
Next i
Case 2
IsDateEx = True
jStart = LBound(TestDate, 2)
If FirstColumnOnly Then
jEnd = LBound(TestDate, 2)
Else
jEnd = UBound(TestDate, 2)
End If
For i = LBound(TestDate, 1) To UBound(TestDate, 1)
For j = jStart To jEnd
If IsDate(TestDate(i, j)) Or IsNumeric(TestDate(i, j)) Then
If Not ((dateLast > CVDate(TestDate(i, j))) And (CVDate(TestDate(i, j)) > dateFirst)) Then
IsDateEx = False
Exit For
End If
Else
IsDateEx = False
Exit For
End If
Next j
Next i
Case Is > 2
' Warning: For... Each enumerations are SLOW
For Each varDate In TestDate
If IsDate(varDate) Or IsNumeric(varDate) Then
If Not ((dateLast > CVDate(varDate)) And (CVDate(varDate) > dateFirst)) Then
IsDateEx = False
Exit For
End If
Else
IsDateEx = False
Exit For
End If
Next varDate
End Select
End If
End Function
A Tip for people still using Excel 2003:
If you (or your users) are going to call IsDateEx() from a worksheet, put these two lines in, immediately below the function header, using a text editor in an exported .bas file and reimporting the file, because VB Attributes are useful, but they are not accessible to the code editor in Excel's VBA IDE:
Attribute IsDateEx.VB_Description = "Returns TRUE if TestDate is a date, and is within ± 20 years of the system date.\r\nChange the defaulte default ± 20 years boundaries by setting values for LimitPastDays and LimitFutureDays\r\nIf you are checking an array of dates, ALL the values will be tested: set FirstColumnOnly TRUE to check the leftmost column only."
That's all one line: watch out for line-breaks inserted by the browser! ...And this line, which puts isDateEX into the function Wizard in the 'Information' category, alongside ISNUMBER(), ISERR(), ISTEXT() and so on:
Attribute IsDateEx.VB_ProcData.VB_Invoke_Func = "w\n9"
Use "w\n2" if you prefer to see it under the Date & Time functions: beats hell outta losing it in the morass of 'Used Defined' functions from your own code, and all those third-party add-ins developed by people who don't do quite enough to help occasional users.
I have no idea whether this still works in Office 2010.
Also, you might need the source for ArrayDimensions:
This API declaration is required in the module header:
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" _
(Destination As Any, _
Source As Any, _
ByVal Length As Long)
…And here's the function itself:
Private Function ArrayDimensions(arr As Variant) As Integer
'-----------------------------------------------------------------
' will return:
' -1 if not an array
' 0 if an un-dimmed array
' 1 or more indicating the number of dimensions of a dimmed array
'-----------------------------------------------------------------
' Retrieved from Chris Rae's VBA Code Archive - http://chrisrae.com/vba
' Code written by Chris Rae, 25/5/00
' Originally published by R. B. Smissaert.
' Additional credits to Bob Phillips, Rick Rothstein, and Thomas Eyde on VB2TheMax
Dim ptr As Long
Dim vType As Integer
Const VT_BYREF = &H4000&
'get the real VarType of the argument
'this is similar to VarType(), but returns also the VT_BYREF bit
CopyMemory vType, arr, 2
'exit if not an array
If (vType And vbArray) = 0 Then
ArrayDimensions = -1
Exit Function
End If
'get the address of the SAFEARRAY descriptor
'this is stored in the second half of the
'Variant parameter that has received the array
CopyMemory ptr, ByVal VarPtr(arr) + 8, 4
'see whether the routine was passed a Variant
'that contains an array, rather than directly an array
'in the former case ptr already points to the SA structure.
'Thanks to Monte Hansen for this fix
If (vType And VT_BYREF) Then
' ptr is a pointer to a pointer
CopyMemory ptr, ByVal ptr, 4
End If
'get the address of the SAFEARRAY structure
'this is stored in the descriptor
'get the first word of the SAFEARRAY structure
'which holds the number of dimensions
'...but first check that saAddr is non-zero, otherwise
'this routine bombs when the array is uninitialized
If ptr Then
CopyMemory ArrayDimensions, ByVal ptr, 2
End If
End Function
Please keep the acknowledgements in your source code: as you progress in your career as a developer, you will come to appreciate your own contributions being acknowledged.
Also: I would advise you to keep that declaration private. If you must make it a public Sub in another module, insert the Option Private Module statement in the module header. You really don't want your users calling any function with CopyMemoryoperations and pointer arithmetic.