Multiple Statement Select Case

[aroig07]

I have been trying to search how to do this and have not come across anything that helps me with what I am trying to accomplish. I have seen select statements with multiple conditions, but not multiple actions. I am trying to replicate a calculation based on if the action is done daily. I am trying to calculate the dates of the current week on a scheduling tool so that they get stored as unique jobs for the date specifically (kind of like a historical repository which will feed my schedule each week when I hit the command button). Since some activities are daily I want them to appear in all of the days on my schedule. Here is the code I have, but its not giving me separate jobs for the daily portion. Marked the portion I am referring to in blue. Thank you so much in advance !!!

Sub FreqCalc()
'macro to loop through the recurrent jobs and create new jobs on master job trail based on their specified frequency
Dim NameRange As Range
Dim CompleteUniqueName As String
Dim Concatenater As Object
Dim UniqueID As Variant
   
    Set Concatenater = CreateObject("scripting.dictionary")
    With Sheets("Recurrent Job Trail")
      
        For Each NameRange In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            CompleteUniqueName = NameRange.Value & " - " & NameRange.Offset(, 3).Value & " ("
                Select Case NameRange.Offset(, 19).Value
[COLOR=#0000ff]                    Case "Diario"[/COLOR]
[COLOR=#0000ff]                        CompleteUniqueName = CompleteUniqueName & (Date - Weekday(Date, vbMonday) + 1) & ")"[/COLOR]
[COLOR=#0000ff]                        CompleteUniqueName = CompleteUniqueName & (Date - Weekday(Date, vbMonday) + 2) & ")"[/COLOR]
[COLOR=#0000ff]                        CompleteUniqueName = CompleteUniqueName & (Date - Weekday(Date, vbMonday) + 3) & ")"[/COLOR]
[COLOR=#0000ff]                        CompleteUniqueName = CompleteUniqueName & (Date - Weekday(Date, vbMonday) + 4) & ")"[/COLOR]
[COLOR=#0000ff]                        CompleteUniqueName = CompleteUniqueName & (Date - Weekday(Date, vbMonday) + 5) & ")"[/COLOR]
                    Case "Semanal"
                        CompleteUniqueName = CompleteUniqueName & "Week of " & (Date - Weekday(Date, vbMonday) + 1) & ")"
                    Case "Mensual"
                        CompleteUniqueName = CompleteUniqueName & Format(Date, "mmm/yyyy") & ")"
                    Case "Trimestral"
                        CompleteUniqueName = CompleteUniqueName & "Trimester starting " & Format(Date, "yyyy") & ")"
                    Case "Anual"
                        CompleteUniqueName = CompleteUniqueName & Format(Date, "yyyy") & ")"
                End Select
            Set Concatenater(CompleteUniqueName) = NameRange
        Next NameRange
       
    End With
   
    With Sheets("Master Job Trail")
        
        For Each NameRange In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
            If Concatenater.Exists(NameRange.Value) Then Concatenater.Remove NameRange.Value
        Next NameRange
        
        For Each UniqueID In Concatenater.Keys
            With .Range("A" & Rows.Count).End(xlUp).Offset(1)
            .Value = UniqueID
            Concatenater(UniqueID).Resize(, 19).Copy
            .Offset(, 1).PasteSpecial xlPasteValues
            End With
        Next UniqueID
    
    End With


End Sub

 

[jjasmith4]

aroig07: your code's problem isn't anything with the Select statement, it's what you're doing in that Diario section. It seems your intent is to post five entries into the Concatenater dictionary, but that's not what's happening. What it's actually doing is forming one long string beginning with two cells' values and one left parentheses and then adding to that string five dates and five right parentheses, so it looks like this: "value - value (mm/dd/yy)mm/dd/yy)mm/dd/yy)mm/dd/yy)mm/dd/yy)". Then it adds that one messy string to the dictionary, because the Set Concatenater statement is run once per For-Next loop iteration.


I think in the "Diario" Case you want five entries in your dictionary, right? Certainly you don't want four unbalanced right parentheses. If this is correct, then Set Concatenater has to happen five times, not just once; please accept my rewrite, which adds two more variables and a small sub:


OLD CODE (indented) -- just the creation of Concatenator followed by the big With block:

Set Concatenater = CreateObject("scripting.dictionary")
With Sheets("Recurrent Job Trail")


 CompleteUniqueName = NameRange.Value & " - " & NameRange.Offset(, 3).Value & " ("

 For Each NameRange In .Range("A2", .Range("A" & Rows.Count).End(xlUp))


  Select Case NameRange.Offset(, 19).Value

  Case "Diario"
   CompleteUniqueName = CompleteUniqueName & (Date - Weekday(Date, vbMonday) + 1) & ")"
   CompleteUniqueName = CompleteUniqueName & (Date - Weekday(Date, vbMonday) + 2) & ")"
   CompleteUniqueName = CompleteUniqueName & (Date - Weekday(Date, vbMonday) + 3) & ")"
   CompleteUniqueName = CompleteUniqueName & (Date - Weekday(Date, vbMonday) + 4) & ")"
   CompleteUniqueName = CompleteUniqueName & (Date - Weekday(Date, vbMonday) + 5) & ")"


  Case "Semanal"
   CompleteUniqueName = CompleteUniqueName & "Week of " & (Date - Weekday(Date, vbMonday) + 1) & ")"


  Case "Mensual"
   CompleteUniqueName = CompleteUniqueName & Format(Date, "mmm/yyyy") & ")"


  Case "Trimestral"
   CompleteUniqueName = CompleteUniqueName & "Trimester starting " & Format(Date, "yyyy") & ")"


  Case "Anual"
   CompleteUniqueName = CompleteUniqueName & Format(Date, "yyyy") & ")"


  End Select


  Set Concatenater(CompleteUniqueName) = NameRange


 Next NameRange


End With

NEW CODE:

Dim Prefix as String  ' Two more variables
Dim D as Long


Set Concatenater = CreateObject("scripting.dictionary")

With Sheets("Recurrent Job Trail")


 Prefix = NameRange.Value & " - " & NameRange.Offset(, 3).Value & " ("


 For Each NameRange In .Range("A2", .Range("A" & Rows.Count).End(xlUp))


  Select Case NameRange.Offset(, 19).Value


  Case "Diario"  
   For D = 1 to 5   
    AddRangeToDictionary Concatenater, NameRange, Prefix & (Date - Weekday(Date, vbMonday) + D) & ")"
   Next D


  Case "Semanal"
   AddRangeToDictionary Concatenater, NameRange, Prefix & "Week of " & (Date - Weekday(Date, vbMonday) + 1) & ")"


  Case "Mensual"
   AddRangeToDictionary Concatenater, NameRange, Prefix & Format(Date, "mmm/yyyy") & ")"


  Case "Trimestral"
   AddRangeToDictionary Concatenater, NameRange, Prefix & "Trimester starting " & Format(Date, "yyyy") & ")"


  Case "Anual"
   AddRangeToDictionary Concatenater, NameRange, Prefix & Format(Date, "yyyy") & ")"


  End Select


 Next NameRange


End With

You'll also need this little Sub:

Private Sub AddRangeToDictionary(Dict as Object, Rng as Range, UniqueName as String)
 Set Dict(UniqueName) = Rng
End Sub

 

[aroig07]

Thank you ! This worked perfectly and did exactly what I needed. Going further if you can answer, I am copying the row of data from which these names are being created to the Master worksheet, I was wondering if there is any way I can copy the formulas as they are without changing. I had them as copy and had to change to paste values because they were calculating wrong, or maybe there is a code where I can drag the formulas down once a new line of data is added. Here is the code I use to copy the row to the Master.

With Sheets("Master Job Trail")

For Each NameRange In .Range("A2", .Range("A" & Rows.Count).End(xlUp))
If Concatenater.Exists(NameRange.Value) Then Concatenater.Remove NameRange.Value
Next NameRange

For Each UniqueID In Concatenater.Keys
With .Range("A" & Rows.Count).End(xlUp).Offset(1)
.Value = UniqueID
Concatenater(UniqueID).Resize(, 19).Copy
.Offset(, 1).PasteSpecial xlPasteValues
End With
Next UniqueID

End With

 

[jjasmith4]

Whatever the formula may be, design the formula with $'s in front of column letters and row numbers you don't want changing, and in code use Range.FormulaR1C1, not just Range.Formula.