2021-05-28

Grouping Worksheets with Similar Name Suffix

I'm struggeling to figure out the best way to attack this problem. I'm looking to group worksheet tabs and color code them based on the suffix.

Eg:

Worksheet Names:

ToDo_XY
Done_ZY
ToDo_ZY
Done_XY

Should be:

ToDo_XY
Done_XY
ToDo_ZY
Done_ZY

I know that the worksheet name will end in "non alphanumeric character" in the 3rd last position then two letters and I need to group by the two letters.

I'm not sure if I should be using a collection, or a dictionary or somehow arrays.

Here is what I have so far:

Public Sub GroupLabSheets()

 Call GetLabListFromTextFile

 Dim ThirdLastCharStr As String, ThirdLastCharStrIsAlphaNumBool As Boolean, PossibleLabStr As String, PossibleLabStrExistsBool As Boolean
 
  For Each ws In ActiveWorkbook.Sheets
  ThirdLastCharStr = Mid(ws.Name, Len(ws.Name) - 3, 1)
  ThirdLastCharStrIsAlphaNumBool = IsAlphaNumeric(ThirdLastCharStr)
  PossibleLabStr = Right(ws.Name, 2)
  PossibleLabStrExistsBool = mylabs.Exists(PossibleLabStr)
     If ThirdLastCharStrIsAlphaNumBool = False And PossibleLabStrExistsBool = True Then
     
      Debug.Print "Worksheet Name = " & ws.Name & " - Index = " & ws.Index
           
     End If
  Next ws
  
   
  Dim WSArr As Variant
  WSArr = Array("ToDo_XY", "Done_XY")
  'WSArr.Move Before:=Sheets(1)

  Dim i As Long
  For i = LBound(WSArr) To UBound(WSArr)
   Debug.Print Worksheets(WSArr(i)).Name
   Worksheets(WSArr(i)).Tab.Color = WHLabTabColor
   Worksheets(WSArr(i)).Move Before:=Sheets(1)
  Next i
End Sub

Public Function IsAlphaNumeric(ByVal vInput As Variant) As Boolean
    On Error GoTo Error_Handler
    Dim oRegEx                As Object
 
    If IsNull(vInput) = False Then
        Set oRegEx = CreateObject("VBScript.RegExp")
        oRegEx.Pattern = "^[a-zA-Z0-9]+$"
        IsAlphaNumeric = oRegEx.Test(vInput)
    Else
        IsAlphaNumeric= True 'Null value returns True, modify as best suits your needs
    End If
 
Error_Handler_Exit:
    On Error Resume Next
    If Not oRegEx Is Nothing Then Set oRegEx = Nothing
    Exit Function
 
Error_Handler:
    Debug.Print "The following error has occured" & vbCrLf & vbCrLf & _
           "Error Number: " & err.Number & vbCrLf & _
           "Error Source: IsAlphaNumeric" & vbCrLf & _
           "Error Description: " & err.Description & _
           Switch(Erl = 0, "", Erl <> 0, vbCrLf & "Line No: " & Erl) _
           , vbOKOnly + vbCritical, "An Error has Occured!"
    Resume Error_Handler_Exit
End Function


from Recent Questions - Stack Overflow https://ift.tt/3vuaZ8x
https://ift.tt/eA8V8J

No comments:

Post a Comment