I have a variable "jobNo" which changes between 1 and 5 depending on user input. I have another 5 variable: "J1C", "J2C", "J3C" ...
How do I place the variable "jobNo" within the other 5 variables so that when jobNo=3 for example I will be able to say:
J3C = 0
I have tried:
"J" & jobNo & "C" = 0
but get errors. How would I do this please?
My suggestion is the same as what #simoco commented. Use an Array:
Dim JC(1 to 5) As Double
JC(1) = 0
JC(2) = 0
JC(3) = 0
JC(4) = 0
JC(5) = 0
You really should use arrays, not doing so, in this case, is very bad programming...
But if it is not possible to change everything you can create this:
Sub VBP(jobNo, J1C, J2C, J3C, J4C, J5C)
Select Case jobNo
Case 1
J1C = 0
Case 2
J2C = 0
Case 3
J3C = 0
Case 4
J4C = 0
Case 5
J5C = 0
End Select
End Sub
and then call it like this:
VBP jobNo, J1C, J2C, J3C, J4C, J5C
Mostly because I hate the vba Array you could use a Collection object
Dim jobNos As New Collection
Sub intializejobNos
With jobNos
.Add 0, "J1C"
.Add 0, "J2C"
.Add 0, "J3C"
.Add 0, "J4C"
.Add 0, "J5C"
End With
End Sub
Sub changeJobNo(jobNo As String, val AS Variant)
OnError GoTo Handler
With jobNos
.Remove jobNo
.Add val, jobNo
End With
Exit_changeJobNo:
Exit Sub
Handler:
Msgbox "Job Number " & jobNo & " Does not exist in the collection."
GoTo Exit_changeJobNo
End Sub
Sub addJobNo(jobNo As Integer, val AS Variant)
jobNos.Add val, "J" & jobNo & "C"
End Sub
This way you can intialize the jobNos Collection whic hwill have a completely variable size without the need to ReDim and then you can change the values where needed and you can then use dynamic functions like you want i.e.
Function getJobNo(jobNo AS Integer) As Variant
If jobNos.Count = 0 Then
initializejobNos
End If
getJobNo = jobNos("J" & jobNo & "C")
End Function
Obviously some additional Error Handling should be put in place but I find Collection objects far easier and more concise than using native VBA Arrays.
Related
In userform1, I have the following code
Private Sub cmdOK_Click()
Dim i As Long
With Me.ListBox2
If .ListCount = 0 Then MsgBox "You Have To Select At Least One Column", vbExclamation: GoTo Skipper
ReDim aCols(0 To .ListCount - 1)
For i = 0 To .ListCount - 1
aCols(i) = "[" & ListBox2.List(i, 0) & "]"
Next i
End With
Skipper:
Unload Me
End Sub
and in standard module I declared aCols as public
Public aCols
if listbox2 has no items then aCols became Empty while if there are items the aCols became an array ..
Then in another code I am confused of how to avoid errors
If UBound(aCols) > -1 Then
This works fine if aCols is not empty but I encountered errors if aCols is Empty .. How to deal with both cases
Simply I need to avoid the errors and deal with aCols either it is empty or either it is an array.
I would use Function safeUBound() which looks ugly due to OERN but works fine:
Function safeUBound(a)
safeUBound = -1
On Error Resume Next
safeUBound = UBound(a)
End Function
Another solution is to assign empty array or empty 2d array to the variable aCols either at the very beginning of the code or at userform initialize.
I'm trying to add a DocumentProperty to the CustomDocumentProperties collection. Code as follows:
Sub testcustdocprop()
Dim docprops As DocumentProperties
Dim docprop As DocumentProperty
Set docprops = ThisWorkbook.CustomDocumentProperties
Set docprop = docprops.Add(Name:="test", LinkToContent:=False, Value:="xyz")
End Sub
Running this gives me the following error:
Run-time error '5':
Invalid procedure call or argument
I tried running it with .Add as a void function, like so:
docprops.Add Name:="test", LinkToContent:=False, Value:="xyz"
This gave me the same error. How do I add a custom document property?
Try this routine:
Public Sub updateCustomDocumentProperty(strPropertyName As String, _
varValue As Variant, docType As Office.MsoDocProperties)
On Error Resume Next
ActiveWorkbook.CustomDocumentProperties(strPropertyName).Value = varValue
If Err.Number > 0 Then
ActiveWorkbook.CustomDocumentProperties.Add _
Name:=strPropertyName, _
LinkToContent:=False, _
Type:=docType, _
Value:=varValue
End If
End Sub
Edit: Usage Examples
Five years later and the 'official' documentation is still a mess on this... I figured I'd add some examples of usage:
Set Custom Properties
Sub test_setProperties()
updateCustomDocumentProperty "my_API_Token", "AbCd1234", msoPropertyTypeString
updateCustomDocumentProperty "my_API_Token_Expiry", #1/31/2019#, msoPropertyTypeDate
End Sub
Get Custom Properties
Sub test_getProperties()
MsgBox ActiveWorkbook.CustomDocumentProperties("my_API_Token") & vbLf _
& ActiveWorkbook.CustomDocumentProperties("my_API_Token_Expiry")
End Sub
List All Custom Properties
Sub listCustomProps()
Dim prop As DocumentProperty
For Each prop In ActiveWorkbook.CustomDocumentProperties
Debug.Print prop.Name & " = " & prop.Value & " (" & Choose(prop.Type, _
"msoPropertyTypeNumber", "msoPropertyTypeBoolean", "msoPropertyTypeDate", _
"msoPropertyTypeString", "msoPropertyTypeFloat") & ")"
Next prop
End Sub
Delete Custom Properties
Sub deleteCustomProps()
ActiveWorkbook.CustomDocumentProperties("my_API_Token").Delete
ActiveWorkbook.CustomDocumentProperties("my_API_Token_Expiry").Delete
End Sub
I figured I should extend the above answer from 2013 to work without having to pass in the docType argument:
Private Function getMsoDocProperty(v As Variant) As Integer
'VB TYPES:
'vbEmpty 0 Empty (uninitialized)
'vbNull 1 Null (no valid data)
'vbInteger 2 Integer
'vbLong 3 Long integer
'vbSingle 4 Single-precision floating-point number
'vbDouble 5 Double-precision floating-point number
'vbCurrency 6 Currency value
'vbDate 7 Date value
'vbString 8 String
'vbObject 9 Object
'vbError 10 Error value
'vbBoolean 11 Boolean value
'vbVariant 12 Variant (used only with arrays of variants)
'vbDataObject 13 A data access object
'vbDecimal 14 Decimal value
'vbByte 17 Byte value
'vbUserDefinedType 36 Variants that contain user-defined types
'vbArray 8192 Array
'OFFICE.MSODOCPROPERTIES.TYPES
'msoPropertyTypeNumber 1 Integer value.
'msoPropertyTypeBoolean 2 Boolean value.
'msoPropertyTypeDate 3 Date value.
'msoPropertyTypeString 4 String value.
'msoPropertyTypeFloat 5 Floating point value.
Select Case VarType(v)
Case vbInteger, vbLong
getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeNumber
Case vbBoolean
getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeBoolean
Case vbDate
getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeDate
Case vbString, vbByte
getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeString
Case vbSingle, vbDouble, vbCurrency,vbDecimal
getMsoDocProperty = Office.MsoDocProperties.msoPropertyTypeFloat
Case Else
getMsoDocProperty = 0
End Select
End Function
Public Sub subUpdateCustomDocumentProperty(ByVal doc as object, ByVal strPropertyName As String, _
ByVal varValue As Variant, Optional ByVal docType As Office.MsoDocProperties = 0)
If docType = 0 Then docType = getMsoDocProperty(varValue)
If docType = 0 Then
MsgBox "An error occurred in ""subUpdateCustomDocumentProperty"" routine", vbCritical
Exit Sub
End If
On Error Resume Next
doc.CustomDocumentProperties(strPropertyName).Value _
= varValue
If Err.Number > 0 Then
doc.CustomDocumentProperties.Add _
Name:=strPropertyName, _
LinkToContent:=False, _
Type:=docType, _
Value:=varValue
End If
End Sub
I use the following code to allow users to write a value into Cell A1.
Sub TestUsername()
If Environ("Username") = "firstname1.lastname1" Or Environ("Username") = "firstname2.lastname2" _
Or Environ("Username") = "firstname3.lastname3" Or Environ("Username") = "firstname4.lastname4" Then
Sheet1.Range("A1").Value = 1
Else
Sheet1.Range("A2").Value = 2
End If
End Sub
As you can see I list each user who is allowed to enter a value into Cell A1 with an OR-condition in my VBA code. All this works fine.
Now, I was wondering if there is an easier way to do this. Something like this:
Sub TestUsername()
If List of or-conditions: {"firstname1.lastname1", "firstname2.lastname2", _
"firstname3.lastname3", "firstname4.lastname4"} = True Then
Sheet1.Range("A1").Value = 1
Else
Sheet1.Range("A2").Value = 2
End If
End Sub
I just know in PHP you can compress multiple conditions like here. Therefore, I thought this might also be possible for VBA programming.
Maybe something like this
Sub TestUsername()
Select Case Environ("Username")
Case "firstname1.lastname1", "firstname2.lastname2", "firstname3.lastname3"
Sheet1.Range("A1").Value = 1
Case Else
Sheet1.Range("A2").Value = 2
End Select
End Sub
I suppose, if you had an atrocious amount of conditions, you could stick them in an array and then simply replace your conditional statement
If Environ("Username") = "firstname1.lastname1" Or Environ("Username") = "firstname2.lastname2" _
Or Environ("Username") = "firstname3.lastname3" Or Environ("Username") = "firstname4.lastname4" Then
with this
If IsInArray(Environ("Username"), arr) Then
This does require that you dimension an array with the conditions first and use this function, however:
Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
Dim i
For i = LBound(arr) To UBound(arr)
If arr(i) = stringToBeFound Then
IsInArray = True
Exit Function
End If
Next i
IsInArray = False
End Function
This way, your code becomes much more readable and easy to maintain.
Since you're working in a cell, you might want to define the allowed usernames within the spreadsheet.
Here's how the spreadsheet table might look:
And here's the code you might use:
Sub TestUsername()
Dim username As String
Dim userInTable As Integer
Dim allowedUserRange As Excel.Range
username = Environ("username")
Set allowedUserRange = Excel.Range("tUsers")
userInTable = Excel.WorksheetFunction.CountIf(allowedUserRange, username)
If userInTable Then
Sheet1.Range("A1").Value = 1
Else
Sheet1.Range("A1").Value = 2
End If
End Sub
The Select Case provides a great solution to testing multiple conditions at the same time. I am using this to alert the user when they have not furnished all the required inputs. I am monitoring inputs from a number of Drop Down Boxes as well as some direct cell inputs.
Select Case True
Case Range("Customer_DD_Control_Cell") > 0 _
And Range("Dealer_DD_Control_Cell") > 0 _
And Range("Rep_DD_Control_Cell") > 0 _
And Range("Product_DD_Control_Cell") > 0 _
And Len(Range("Customer_State_Input")) > 0 _
And Len(Range("Contract_Date_Input")) > 0
Case Else
MsgBox "You have not completed the required inputs"
End Select
These if ... then statements are getting the wrong results in my opinion. The first is returning the value 'false' when it should be 'true'. The fourth returns the right value. The second and third return an error.
Sub empty_array()
Dim arr1() As Variant
If IsEmpty(arr1) Then
MsgBox "hey"
End If
If IsError(UBound(arr1)) Then
MsgBox "hey"
End If
If IsError(Application.match("*", (arr1), 0)) Then
MsgBox "hey"
End If
ReDim arr1(1)
arr1(1) = "hey"
If IsEmpty(arr1) Then
MsgBox "hey"
End If
End Sub
Arr1 becomes an array of 'Variant' by the first statement of your code:
Dim arr1() As Variant
Array of size zero is not empty, as like an empty box exists in real world.
If you define a variable of 'Variant', that will be empty when it is created.
Following code will display "Empty".
Dim a as Variant
If IsEmpty(a) then
MsgBox("Empty")
Else
MsgBox("Not Empty")
End If
Adding into this: it depends on what your array is defined as. Consider:
dim a() as integer
dim b() as string
dim c() as variant
'these doesn't work
if isempty(a) then msgbox "integer arrays can be empty"
if isempty(b) then msgbox "string arrays can be empty"
'this is because isempty can only be tested on classes which have an .empty property
'this do work
if isempty(c) then msgbox "variants can be empty"
So, what can we do? In VBA, we can see if we can trigger an error and somehow handle it, for example
dim a() as integer
dim bEmpty as boolean
bempty=false
on error resume next
bempty=not isnumeric(ubound(a))
on error goto 0
But this is really clumsy... A nicer solution is to declare a boolean variable (a public or module level is best). When the array is first initialised, then set this variable.
Because it's a variable declared at the same time, if it loses it's value, then you know that you need to reinitialise your array.
However, if it is initialised, then all you're doing is checking the value of a boolean, which is low cost. It depends on whether being low cost matters, and if you're going to be needing to check it often.
option explicit
'declared at module level
dim a() as integer
dim aInitialised as boolean
sub DoSomethingWithA()
if not aInitialised then InitialiseA
'you can now proceed confident that a() is intialised
end sub
sub InitialiseA()
'insert code to do whatever is required to initialise A
'e.g.
redim a(10)
a(1)=123
'...
aInitialised=true
end sub
The last thing you can do is create a function; which in this case will need to be dependent on the clumsy on error method.
function isInitialised(byref a() as variant) as boolean
isInitialised=false
on error resume next
isinitialised=isnumeric(ubound(a))
end function
#jeminar has the best solution above.
I cleaned it up a bit though.
I recommend adding this to a FunctionsArray module
isInitialised=false is not needed because Booleans are false when created
On Error GoTo 0 wrap and indent code inside error blocks similar to with blocks for visibility. these methods should be avoided as much as possible but ... VBA ...
Function isInitialised(ByRef a() As Variant) As Boolean
On Error Resume Next
isInitialised = IsNumeric(UBound(a))
On Error GoTo 0
End Function
I would do this as
if isnumeric(ubound(a)) = False then msgbox "a is empty!"
I may be a bit late, but following simple stuff works with string arrays:
Dim files() As String
files = "..." 'assign array
If Not Not files Then
For i = LBound(files) To UBound(files)
'do stuff, array is not empty
Next
End If
That's all the code for this.
Above methods didn´t work for me. This did:
Dim arrayIsNothing As Boolean
On Error Resume Next
arrayIsNothing = IsNumeric(UBound(YOUR_ARRAY)) And False
If Err.Number <> 0 Then arrayIsNothing = True
Err.Clear
On Error GoTo 0
'Now you can test:
if arrayIsNothing then ...
this worked for me:
Private Function arrIsEmpty(arr as variant)
On Error Resume Next
arrIsEmpty = False
arrIsEmpty = IsNumeric(UBound(arr))
End Function
The problem with VBA is that there are both dynamic and static arrays...
Dynamic Array Example
Dim myDynamicArray() as Variant
Static Array Example
Dim myStaticArray(10) as Variant
Dim myOtherStaticArray(0 To 10) as Variant
Using error handling to check if the array is empty works for a Dynamic Array, but a static array is by definition not empty, there are entries in the array, even if all those entries are empty.
So for clarity's sake, I named my function "IsZeroLengthArray".
Public Function IsZeroLengthArray(ByRef subject() As Variant) As Boolean
'Tell VBA to proceed if there is an error to the next line.
On Error Resume Next
Dim UpperBound As Integer
Dim ErrorNumber As Long
Dim ErrorDescription As String
Dim ErrorSource As String
'If the array is empty this will throw an error because a zero-length
'array has no UpperBound (or LowerBound).
'This only works for dynamic arrays. If this was a static array there
'would be both an upper and lower bound.
UpperBound = UBound(subject)
'Store the Error Number and then clear the Error object
'because we want VBA to treat unintended errors normally
ErrorNumber = Err.Number
ErrorDescription = Err.Description
ErrorSource = Err.Source
Err.Clear
On Error GoTo 0
'Check the Error Object to see if we have a "subscript out of range" error.
'If we do (the number is 9) then we can assume that the array is zero-length.
If ErrorNumber = 9 Then
IsZeroLengthArray = True
'If the Error number is something else then 9 we want to raise
'that error again...
ElseIf ErrorNumber <> 0 Then
Err.Raise ErrorNumber, ErrorSource, ErrorDescription
'If the Error number is 0 then we have no error and can assume that the
'array is not of zero-length
ElseIf ErrorNumber = 0 Then
IsZeroLengthArray = False
End If
End Function
I hope that this helps others as it helped me.
I'm using this
If UBound(a) >= 0 Then
' not empty
Else
' empty... UBound(a) = -1
End If
IsEmpty(a) did not work for me... I hate VBA
Dim arr() As Variant
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' raises error
arr = Array()
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' -1
ReDim Preserve arr(UBound(arr) + 1)
arr(UBound(arr)) = "test"
Debug.Print IsEmpty(arr) ' False
Debug.Print UBound(arr) ' 0
The below function works for both static and dynamic arrays.
Function array_Empty(testArr As Variant) As Boolean
Dim i As Long, k As Long, flag As Long
On Error Resume Next
i = UBound(testArr)
If Err.Number = 0 Then
flag = 0
For k = LBound(testArr) To UBound(testArr)
If IsEmpty(testArr(k)) = False Then
flag = 1
array_Empty = False
Exit For
End If
Next k
If flag = 0 Then array_Empty = True
Else
array_Empty = True
End If
End Function
Tente isso:
Function inic(mtz As Variant) As Boolean
On Error Resume Next
Dim x As Boolean
x = UBound(mtz): inic = x
End Function
...
if inic(mymtz) then
debug.print "iniciada"
else
debug.print "não iniciada"
end if
I have a userform with 6 list objects. All of the list objects have named range rowsources. Clicking any one item in any one list will reference a chart on a spreadsheet and clear contents of any item's cell that does not belong with what was selected (explained better at the bottom of this, if you're interested). All of my list objects only have "After Update" triggers, everything else is handled by private subs.
Anyway, there's a lot of looping and jumping from list to list. If I run the userform normally, it endlessly loops. It seems to run through once, and then acts as though the user has again clicked the same item in the list, over and over again.
The odd thing is, if I step through the code (F8), it ends perfectly, when it's supposed to and control is returned to the user.
Does anyone have any thoughts on why that might be?
EDIT: I didn't originally post the code because all of it is basically a loop, and there's 150+ lines of it. I don't understand how it can be the code if stepping through makes it work perfectly, but allowing it to run regular makes it endless loop. Anyway, here's the code:
Option Explicit
Dim arySelected(6) As String
Dim intHoldCol As Integer, intHoldRow As Integer
Dim strHold As String
Dim rngStyleFind As Range, rngStyleList As Range
Private Sub UserForm_Activate()
Set rngStyleList = Range("Lists_W_Style")
Set rngStyleFind = Range("CABI_FindStyle")
End Sub
Private Sub lstStyle_AfterUpdate()
If lstStyle.ListIndex >= 0 Then
arySelected(0) = lstStyle.Value
Call FilterCabinetOptions(Range("Lists_W_Style"), Range("CABI_FindStyle"), 0)
End If
End Sub
Private Sub lstWood_AfterUpdate()
If lstWood.ListIndex >= 0 Then
arySelected(1) = lstWood.Value
Call FilterCabinetOptions(Range("Lists_W_Wood"), Range("CABI_FindWood"), 1)
' lstWood.RowSource = "Lists_W_Wood"
End If
End Sub
Private Sub cmdReset_Click()
Range("Lists_S_Style").Copy Destination:=Range("Lists_W_Style")
Call RemoveXes(Range("Lists_W_Style"))
Range("Lists_S_Wood").Copy Destination:=Range("Lists_W_Wood")
Call RemoveXes(Range("Lists_W_Wood"))
Range("Lists_S_Door").Copy Destination:=Range("Lists_W_Door")
Call RemoveXes(Range("Lists_W_Door"))
Range("Lists_S_Color").Copy Destination:=Range("Lists_W_Color")
Call RemoveXes(Range("Lists_W_Color"))
Range("Lists_S_Glaze").Copy Destination:=Range("Lists_W_Glaze")
Call RemoveXes(Range("Lists_W_Glaze"))
Range("Lists_S_Const").Copy Destination:=Range("Lists_W_Const")
Call RemoveXes(Range("Lists_W_Const"))
Range("Lists_S_DrawFrontConst").Copy Destination:=Range("Lists_W_DrawFrontConst")
Call RemoveXes(Range("Lists_W_DrawFrontConst"))
End Sub
Private Sub FilterCabinetOptions(rngList As Range, rngFind As Range, intAry As Integer)
Dim intListCntr As Integer, intFindCntr As Integer, intStyleCntr As Integer
If intAry = 0 Then
Call FindStyle(arySelected(intAry))
Else
'Save the List item.
For intListCntr = 1 To rngList.Rows.Count
If rngList.Cells(intListCntr, 1) = arySelected(intAry) Then
rngList.Cells(intListCntr, 3) = "X"
' Call RemoveNonXes(rngList)
Exit For
End If
Next intListCntr
'Save the column of the Find List.
For intFindCntr = 1 To rngFind.Columns.Count
If rngFind.Cells(1, intFindCntr) = arySelected(intAry) Then
'Minus 2 to allow for columns A and B when using Offset in the below loop.
intHoldCol = rngFind.Cells(1, intFindCntr).Column - 2
Exit For
End If
Next intFindCntr
'Find appliciple styles.
For intStyleCntr = 1 To rngStyleFind.Rows.Count
If Len(rngStyleFind.Cells(intStyleCntr, intHoldCol)) > 0 Then
Call FindStyle(rngStyleFind.Cells(intStyleCntr, 1))
End If
Next intStyleCntr
End If
Call RemoveNonXes(rngStyleList)
Call RemoveNonXes(Range("Lists_W_Wood"))
Call RemoveNonXes(Range("Lists_W_Door"))
Call RemoveNonXes(Range("Lists_W_Color"))
Call RemoveNonXes(Range("Lists_W_Glaze"))
Call RemoveNonXes(Range("Lists_W_Const"))
Call RemoveNonXes(Range("Lists_W_DrawFrontConst"))
End Sub
Private Sub FindStyle(strFindCode As String)
Dim intListCntr As Integer, intFindCntr As Integer
For intListCntr = 1 To rngStyleList.Rows.Count
If rngStyleList.Cells(intListCntr, 1) = strFindCode Then
rngStyleList.Range("C" & intListCntr) = "X"
Exit For
End If
Next intListCntr
For intFindCntr = 1 To rngStyleFind.Rows.Count
If rngStyleFind.Cells(intFindCntr, 1) = strFindCode Then
intHoldRow = rngStyleFind.Cells(intFindCntr).Row
Exit For
End If
Next intFindCntr
If Len(arySelected(1)) = 0 Then Call FindStyleOptions(Range("CABI_FindWood"), Range("Lists_W_Wood"))
If Len(arySelected(2)) = 0 Then Call FindStyleOptions(Range("CABI_FindDoor"), Range("Lists_W_Door"))
If Len(arySelected(3)) = 0 Then Call FindStyleOptions(Range("CABI_FindColor"), Range("Lists_W_Color"), Range("Lists_W_Wood"))
If Len(arySelected(4)) = 0 Then Call FindStyleOptions(Range("CABI_FindGlaze"), Range("Lists_W_Glaze"), Range("Lists_W_Wood"))
If Len(arySelected(5)) = 0 Then Call FindStyleOptions(Range("CABI_FindConst"), Range("Lists_W_Const"))
If Len(arySelected(6)) = 0 Then Call FindStyleOptions(Range("CABI_FindDrawFrontConst"), Range("Lists_W_DrawFrontConst"))
End Sub
Private Sub FindStyleOptions(rngFind As Range, rngList As Range, Optional rngCheckList As Range)
Dim intListCntr As Integer, intFindCntr As Integer
Dim intStrFinder As Integer, intCheckCntr As Integer
Dim strHoldCheck As String
Dim strHoldFound As String, strHoldOption As String
'Go through the appropriate find list (across the top of CABI)
For intFindCntr = 1 To rngFind.Columns.Count
strHoldOption = rngFind.Cells(1, intFindCntr)
strHoldFound = rngFind.Cells(1, intFindCntr).Offset((intHoldRow - 1), 0)
If Len(strHoldFound) > 0 Then
If rngCheckList Is Nothing Then
For intListCntr = 1 To rngList.Rows.Count
If rngList.Cells(intListCntr, 1) = strHoldFound Then
Call AddXes(rngList, strHoldFound, "X")
Exit For
End If
Next intListCntr
Else
intStrFinder = 1
Do While intStrFinder < Len(rngFind.Cells(1, intFindCntr).Offset((intHoldRow - 1), 0))
strHoldCheck = Mid(rngFind.Cells(1, intFindCntr).Offset((intHoldRow - 1), 0), intStrFinder, 2)
intStrFinder = intStrFinder + 3
For intCheckCntr = 1 To rngCheckList.Rows.Count
If strHoldCheck = rngCheckList(intCheckCntr, 1) And Len(rngCheckList(intCheckCntr, 3)) > 0 Then
Call AddXes(rngList, strHoldOption, "X")
intStrFinder = 99
Exit For
End If
Next intCheckCntr
Loop
End If
End If
Next intFindCntr
End Sub
Private Sub AddXes(rngList As Range, strToFind As String, strX As String)
Dim intXcntr As Integer
For intXcntr = 1 To rngList.Rows.Count
If rngList.Cells(intXcntr, 1) = strToFind Then
rngList.Cells(intXcntr, 3) = strX
Exit For
End If
Next intXcntr
End Sub
Private Sub RemoveNonXes(rngList As Range)
Dim intXcntr As Integer
For intXcntr = 1 To rngList.Rows.Count
If Len(rngList(intXcntr, 3)) = 0 Then
rngList.Range("A" & intXcntr & ":B" & intXcntr) = ""
Else
rngList.Range("C" & intXcntr) = ""
End If
Next intXcntr
End Sub
Private Sub RemoveXes(rngList As Range)
rngList.Range("C1:C" & rngList.Rows.Count) = ""
End Sub
Explanation:
Imagine you had 6 lists with different automobile conditions. So Make would be one list with Chevy, Ford, Honda... Model would be another with Malibu, Focus, Civic... But you'd also have Color Blue, Red, Green... So if your user wants a Green car, the program references an inventory list and gets rid of any Makes, Models, etc... not available in green. Likewise the user could click on Civic from the Model list and it would elminate all but Honda from the Make and so on. That's what I'm trying to do anyway.
Without seeing the code it's tough to tell. When you run the script, the 'AfterUpdate' event may be getting triggered over and over, causing the endless loop. Try using a counter to limit the update to one change and have it exit the loop once the counter is greater than 0.