Select Case Multiple Values

[hamistasty]

I have a macro that checks the value of a cell in column A down each row & depending on the value will carry out a case. The case uses that row of data to copy and paste into a template to generate a sheet. The template depends on the value of column A, row i.

Long story short: I want to be able to put multiple values in that cell it checks seperated by spaces, & for the macro to be able to carry out multiple cases for the one row. Eg. column A & i has FIC001 FIC002 FIC003 as values, so the new code will use template FIC001, FIC002 & FIC003 (Case 1, 2 & 3) on that one row of data. Whereas currently it can only use one case (FIC001 in column A & i will use case 1 etc.)

Here's is the existing code:

Sub create()
Dim ws As Worksheet, i As Long
Dim strName As String, counter As Integer
    Application.ScreenUpdating = False      
       
    With Sheets("Schedule")                  
        For i = 6 To .Range("C" & Rows.Count).End(xlUp).Row             
            Sheets(.Range("A" & i).Value).Copy After:=Sheet(Sheets.Count) 
            Set ws = ActiveSheet
            ws.visible = True
                    
            strName = .Range("B" & i).Text            
            If Len(strName) > 0 Then
                counter = 1
                On Error Resume Next
                Do
                ws.Name = strName & IIf(counter = 1, "", " (" & counter & ")")
                    counter = counter + 1
                Loop Until Left(ws.Name, Len(strName)) = strName
                On Error GoTo 0
            End If
                        
               Select Case CInt(Mid(.Range("A" & i).Value, 4, 3))
                
               Case 1
                
               Case 2
                                 
               Case 3
               
                           End Select
            
        Next i
        
    End With
    
     Sheets("Schedule").Select           
    Application.ScreenUpdating = True  
    
End Sub

 

[Gary McMaster]

Maybe you could use the "Split" function and disassemble your string using the space as the delimiter?

I hope the sample below will help.

Gary

Public Sub Test()

Dim vSplit As Variant
Dim iCount As Integer

'Assumes the string "FIC001 FIC002 FIC003" is in "A1"
vSplit = Split(ActiveSheet.Range("A1").Value, " ")

For iCount = LBound(vSplit) To UBound(vSplit)
    Select Case vSplit(iCount)
    
        Case "FIC001"
            MsgBox "FIC001"
            
        Case "FIC002"
            MsgBox "FIC002"

        Case "FIC003"
            MsgBox "FIC003"
        Case Else
            
    End Select
Next iCount

End Sub

 

[hamistasty]

What if I want to split the cell of each A row inside the For statement? I need to keep this code.

For example:

For I = 6 To .Range("C" & Rows.Count).End(xlUp).Row
 Sheets(.Range("A" & I).Value).Copy After:=Sheets(Sheets.Count)
 
   Select Case CInt(Mid(.Range("A" & I).Value, 4, 3))
 
      Case 1

So every time it checks the value of (A & I) I want the code to use spaces as a delimitre so that it can carry out multiple Case's for that one row of data if there are multiple values in that row seperated by spaces.

Then it goes on to the next row and carries out the multiple cases there etc. until the For is complete.

 

[hamistasty]

Any help?

 

[hamistasty]

I'll give it one more shot. Any help on this?

 

[Gary McMaster]

Nest something similar to the above sample code inside your existing loop.

Gary

For I = 6 To .Range("C" & Rows.Count).End(xlUp).Row
 Sheets(.Range("A" & I).Value).Copy After:=Sheets(Sheets.Count)
 
   'Select Case CInt(Mid(.Range("A" & I).Value, 4, 3))
 
      'Case 1
        vSplit = Split(ActiveSheet.Range("A" & I).Value, " ")
        
        For iCount = LBound(vSplit) To UBound(vSplit)
            Select Case vSplit(iCount)
            
                Case "FIC001"
                    MsgBox "FIC001"
                    
                Case "FIC002"
                    MsgBox "FIC002"
        
                Case "FIC003"
                    MsgBox "FIC003"
                Case Else
                    
            End Select
        Next iCount

    'The rest of your missing code