VBA - Using Replace for Strings

[beartooth91]

I'm having some issues with my VBA for Replace...

I have a frequently updated sheets with a bunch of tag names with the format as follows:

1-SYS-CC-0001 or
1-SYS-CC-0001-xxx

I'm trying to replace the 2nd, 2nd/3rd, or 2nd/3rd/4th letters in the CC portion.
The CC portion can be
AE, AT, FE, FT, PDIT, PDT, TE, TT, TIT, and there are lots more
If its the two character version, I want to replace the E, T, IT with I. For the 3 and 4 character versions PDT and PDIT should both be PDI and TIT should just be TI.
The code I'm using mostly works but when it hits 1-SYS-TT-0001, I end up with 1-SYS-II-0001 which isn't right.

Sub Point_Correct()
With Worksheets("NIC Master IO List")
'Define Variables
  Dim LastRow As Long, cell As Range, cCodeNew As String, cCodeOld As String, CompNum As String, ccArray() As String
 
  LastRow = .Cells(Rows.Count, "B").End(xlUp).Row
'Replace Indicating Transmitter with Indication
 
  For Each cell In .Range("B11:B" & LastRow)
    ccArray = Split(cell.Value, "-", -1)
    cCodeOld = ccArray(2)
    cCodeNew = Replace(cCodeOld, "IT", "I")
    'CompNum = Replace(Mid(cell.Value, 7, 2), "AE", "AI")
    CompNum = Replace(cell.Value, cCodeOld, cCodeNew)
    cell.Value = CompNum
  Next cell
 
'Replace Element with Indication
 
  For Each cell In .Range("B11:B" & LastRow)
    ccArray = Split(cell.Value, "-", -1)
    cCodeOld = ccArray(2)
    cCodeNew = Replace(cCodeOld, "E", "I")
    'CompNum = Replace(Mid(cell.Value, 7, 2), "AE", "AI")
    CompNum = Replace(cell.Value, cCodeOld, cCodeNew)
    cell.Value = CompNum
  Next cell
 
'Replace Transmitter with Indication
 
  For Each cell In .Range("B11:B" & LastRow)
    ccArray = Split(cell.Value, "-", -1)
    cCodeOld = ccArray(2)
    cCodeNew = Replace(cCodeOld, "T", "I")
    'CompNum = Replace(Mid(cell.Value, 7, 2), "AE", "AI")
    CompNum = Replace(cell.Value, cCodeOld, cCodeNew)
    cell.Value = CompNum
  Next cell
 

End With
End Sub

Oh, and if I try a starting position of 2 in the Replace syntax such as

cCodeNew = Replace(cCodeOld, "E", "I", 2)

it drops the CC portion entirely and I end up with

1-SYS--0001

 

[Edgar_]

Try this version with less loops.

Sub Point_Correct()
    With Worksheets("NIC Master IO List")
        Dim LastRow As Long
        LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
       
        Dim rng As Range
        Dim txtArr() As String
        Dim arrItem As String, itemStart As String, itemRest As String, corr As String
       
        For Each rng In .Range("B11:B" & LastRow)
            txtArr = Split(rng.Value, "-")
            arrItem = txtArr(2)
            itemStart = Left(arrItem, 1)
            itemRest = Mid(arrItem, 2)
           
            Select Case Len(arrItem)
                Case 2
                    If arrItem = "IT" Or itemRest = "E" Or itemRest = "T" Then corr = "I"
                Case Else
                    If Left(itemRest, 1) = "D" Then corr = "DI" Else corr = "I"
            End Select
           
            txtArr(2) = itemStart & corr
            rng.Value = Join(txtArr, "-")
        Next rng
    End With
End Sub