If result contains a letter, paste to a different cell

Hi All. So I have written some code that will split up the characters in a cell and paste them in adjacent cells. The last characters it pastes are some numbers. Sometimes though this number will contain one letter (from A-Z) at the end it. If this is the case I would like that letter to get pasted in the next cell adjacent to where the number will end up. Any thoughts would be appreciated.

I have the code working to do this:
82XX-103A Will get split up 82>X>X>103A (using ">" to illustrate next adjacent cell)
82XXX-103A Will get split up 82>X>X>X>103A
82XXXX-103A Will get split up 82>X>X>XX>103A

I would rather:
82XX-103A Will get split up 82>X>X>103>A
82XXX-103A Will get split up 82>X>X>X>103>A
82XXXX-103A Will get split up 82>X>X>XX>103>A

Working Code (I suspect their may be some unnecessary things it took a bit to get this far):

Sub FindCharacter()

Dim s As String
Dim Slash As Long
Dim Plant As String
Dim Inst As String
Dim inst1 As String
Dim tag As String
Dim r As Range

Range("C4").Select
Do Until ActiveCell.Value = ""

s = ActiveCell.Value

Slash = InStr(1, s, "-")
Plant = Left(s, 2)
Inst = Right(s, Len(s) - 2)
inst1 = InStr(1, Inst, "-")
tag = Left(Inst, inst1 - 1)
ActiveCell.Offset(0, 1).Value = Plant

Select Case True
    Case Len(tag) = 4
        ActiveCell.End(xlToRight).Offset(0, 1).Value = Left(tag, 1)
        ActiveCell.End(xlToRight).Offset(0, 1).Value = Mid(tag & "", 2, 1)
        ActiveCell.End(xlToRight).Offset(0, 1).Value = Right(tag, 2)
    Case Len(tag) = 3
        ActiveCell.End(xlToRight).Offset(0, 1).Value = Left(tag, 1)
        ActiveCell.End(xlToRight).Offset(0, 1).Value = Mid(tag & "", 2, 1)
        ActiveCell.End(xlToRight).Offset(0, 1).Value = Right(tag, 1)
     Case Len(tag) = 2
        ActiveCell.End(xlToRight).Offset(0, 1).Value = Left(tag, 1)
        ActiveCell.End(xlToRight).Offset(0, 1).Value = Right(tag, 1)
               
End Select

'Program will past the fourth letter identifier if present in the same cell as the 3rd letter
    
    If Len(tag) = 2 Then
        ActiveCell.Offset.End(xlToRight).Offset(0, 2).Value = Mid(s, Slash + 1)
      Else
        ActiveCell.Offset.End(xlToRight).Offset(0, 1).Value = Mid(s, Slash + 1)
    End If

ActiveCell.Offset(1, 0).Select

Loop

End Sub