VBA code to replace "1" with "7:00/ 15:30"

[Paul_Hossler]

This will do the 1,2,3 conversion, but the tiny column width is a problem for the longer strings

Capture.JPG

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim r As Range
    Dim iLastRow As Long, iLastCol As Long


    Set r = Target.Cells(1, 1)
    
    If Len(r.Value) = 0 Then Exit Sub
    
    With Me
        iLastRow = .Cells(.Rows.Count, 2).End(xlUp).Row + 1
        iLastCol = .Cells(2, .Columns.Count).End(xlToLeft).Column
    End With
    
    With r
        If .Row < 4 Or .Row > iLastRow Then Exit Sub
        If .Column < 3 Or .Column > iLastCol Then Exit Sub
        
        Application.EnableEvents = False
        Select Case .Value      '   1st is from     7 to 15:30, 2nd is from 13:30 to 22:00 and 3rd is from 22:00 to 06:30.
            Case 1
                .Value = "7:00/15:30"
            Case 2
                .Value = "13:30/22:00"
            Case 3
                .Value = "22:00/06:30"
        End Select
        Application.EnableEvents = True
    End With

End Sub