How do I add to an array based on a Case?

AFGPHXExcel
AFGPHXExcel used Ask the Experts™
on
Is it possible to set the values for an Array using a Case. For example

Select Case Range("A1").Value
Case B
v_WksNames = Array("RequirementSummary")
Case C
v_WksNames = Array("Reviewer1", "LOJ")

What if the range contains both B and C? Is it possible to make the array v_WksNames = Array("RequirementSummary", "Reviewer1", "LOJ")?
Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
If B an V are variables then the syntax looks ok. If they are values then enclose them in quotes "B" "C"
Software Quality Lead Engineer
Top Expert 2011
Commented:
Strictly speaking you can't since range("A1").Value cannot equal two different things.  WHat I have however done below is a sub to test A1 a number of times and via a function add the items to the array.

As designed the function assumes case insensitive which means DD is the same as dD, it also assumes any datum occurs but once in the final array.  i.e.  duplication of entries in the array is not supported.

Chris
Sub testdd()
Dim v_WksNames() As Variant

    v_WksNames = Array()
    If InStr(1, Range("A1").Value, "a", vbTextCompare) > 0 Then _
            v_WksNames = addArray(v_WksNames, "RequirementSummary")
    If InStr(1, Range("A1").Value, "B", vbTextCompare) > 0 Then _
            v_WksNames = addArray(v_WksNames, "Something else")
    If InStr(1, Range("A1").Value, "C", vbTextCompare) > 0 Then _
            v_WksNames = addArray(v_WksNames, "Reviewer1")
            v_WksNames = addArray(v_WksNames, "LOJ")
    v_WksNames = addArray(v_WksNames, "Something ELSE")
            
End Sub

Function addArray(srcArray As Variant, addItem As Variant) As Variant
Dim coll As Object
Dim itm As Variant

    Set coll = CreateObject("scripting.dictionary")
    coll.comparemode = vbTextCompare
    For Each itm In srcArray
        If Not coll.exists(itm) Then coll.Add itm, itm
    Next
    If Not coll.exists(addItem) Then coll.Add addItem, addItem
    addArray = coll.keys

End Function

Open in new window

Chris BottomleySoftware Quality Lead Engineer
Top Expert 2011
Commented:
If you want the output to be a duuplicate then a different approach is required.  See the following which adds whatever to the array duplicates supported therefore.

Chris
Sub testdd()
Dim v_WksNames() As Variant

    v_WksNames = Array()
    If InStr(1, Range("A1").Value, "a", vbTextCompare) > 0 Then _
            v_WksNames = addArray2(v_WksNames, "RequirementSummary")
    If InStr(1, Range("A1").Value, "B", vbTextCompare) > 0 Then _
            v_WksNames = addArray2(v_WksNames, "Something else")
    If InStr(1, Range("A1").Value, "C", vbTextCompare) > 0 Then _
            v_WksNames = addArray2(v_WksNames, "Reviewer1")
            v_WksNames = addArray2(v_WksNames, "LOJ")
    v_WksNames = addArray2(v_WksNames, "Something ELSE")
            
End Sub

Function addArray2(srcArray As Variant, addItem As Variant) As Variant
Dim nuArray() As Variant
Dim itm As Integer
    
    nuArray = Array(0)
    If UBound(srcArray) >= 0 Then
        ReDim nuArray(LBound(srcArray) To UBound(srcArray) + 1)
        For itm = LBound(srcArray) To UBound(srcArray)
            nuArray(itm) = srcArray(itm)
        Next
    End If
    nuArray(UBound(srcArray) + 1) = addItem
    addArray2 = nuArray

End Function

Open in new window

Become a CompTIA Certified Healthcare IT Tech

This course will help prep you to earn the CompTIA Healthcare IT Technician certification showing that you have the knowledge and skills needed to succeed in installing, managing, and troubleshooting IT systems in medical and clinical settings.

Chris, the range("A1").Value could be "BC". So in that case the OP's hypothesis seems ok.

Saqib
Chris BottomleySoftware Quality Lead Engineer
Top Expert 2011

Commented:
ssaqibh

Are you trying to say something is wrong?
I was just trying to respond to your statement

"Strictly speaking you can't since range("A1").Value cannot equal two different things..."

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial