VBA automatically to add 0 all single digit hours

[hajiali]

Hello everyone I want to accomplish the following with this vba:

in Range (D2:D2002) users will be typing STW, PSTW, TTW followed by space and then start and end time without colons. ex. "STW 900-1730" , "PSTW 2100-2130" or "TTW 430-1300"

what I need the code to do is for all single digit start times from 1-9 to add a 0 in front.
ex.
"STW 900-1730" should change automatically to "STW 0900-1730"
"TTW 430-1300" to "TTW 0430-1300"
"PSTW 700-800" to "PSTW 0700-800"
it would be nice if the single digits after "-" to add 0 in front if not to complicated so if "PSTW 700-800" becomes "PSTW 0700-0800" that would be wonderful if not "PSTW 0700-800" would be good aswell.

any help is greatly appreciated

I do currently have the below code to check for space between STW, PSTW, and TTW just like to add the above feature.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
        If Not Application.Intersect(Target, Me.Range("D2:D2002")) Is Nothing Then
            If Left(Target, 4) = "STW " Or Left(Target, 5) = "PSTW " Or Left(Target, 4) = "TTW " Then
            Exit Sub
                Else
        MsgBox ("ALL SHIFT MUST INCLUDE STW, PSTW, TTW FOLLOWED BY A SPACE")
        Application.EnableEvents = False
        Target = ""
        Application.EnableEvents = True
        Target.Select
    End If
    End If
End Sub

 

[Anthony47]

Maybe this variant:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim myMust, myMatch, mySplit
'
myMust = Array("STW ", "PSTW ", "TTW ")
    If Target.Count > 1 Then Exit Sub
    If Not Application.Intersect(Target, Me.Range("D2:D2002")) Is Nothing Then
        myMatch = Application.Match(Left(Target.Value & "__", 4), myMust, False)
        If Not IsError(myMatch) Then  '  Left(Target, 4) = "STW " Or Left(Target, 5) = "PSTW " Or Left(Target, 4) = "TTW " Then
            mySplit = Split(Replace(Target.Value & "-   ", myMust(myMatch - 1), "", , , vbTextCompare), "-", , vbTextCompare)
            If Len(mySplit(0)) < 4 Then
                Application.EnableEvents = False
                    Target.Value = Replace(Target.Value, " " & mySplit(0), " " & String(4 - Len(mySplit(0)), "0") & mySplit(0), , , vbTextCompare)
                Application.EnableEvents = True
            End If
            Exit Sub
        Else
            MsgBox ("ALL SHIFT MUST INCLUDE STW, PSTW, TTW FOLLOWED BY A SPACE")
            Application.EnableEvents = False
            Target.ClearContents
            Application.EnableEvents = True
            Target.Select
        End If
End If
End Sub

Bye

 

[hajiali]

this works for the adding the 0 however I did encounter the error message

("ALL SHIFT MUST INCLUDE STW, PSTW, TTW FOLLOWED BY A SPACE")

appear when typing:
"PSTW 600-0700"
Although there was a space. does the number "4" in the code effect this because LEN("PSTW ") is 5 not 4. Im not getting the error for "TTW " or "STW " the above code works great for the single digits hours

 

[sericom]

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
        If Not Application.Intersect(Target, Me.Range("D2:D2002")) Is Nothing Then        
            If Left(Target, 4) = "STW " Or Left(Target, 5) = "PSTW " Or Left(Target, 4) = "TTW " Then
                uTime = Split(Target, " ")
                stime = Split(uTime(1), "-")
                If Len(stime(0)) = 3 Then
                    stime(0) = "0" & stime(0)
                End If
                If Len(stime(1)) = 3 Then
                    stime(1) = "0" & stime(1)
                End If
                Application.EnableEvents = False
                Target = uTime(0) & " " & stime(0) & "-" & stime(1)
                Application.EnableEvents = True
                Exit Sub
        Else
            MsgBox ("ALL SHIFT MUST INCLUDE STW, PSTW, TTW FOLLOWED BY A SPACE")
            Application.EnableEvents = False
            Target = ""
            Application.EnableEvents = True
            Target.Select
        End If
    End If
End Sub

 

[hajiali]

Perfect works like magic.