Convert TEXT back to TEXT after this code converts it to unwanted DATE format??

[ChrisOK]

Col A holds a Book/Chapter refc from a Tech Order in the following "General" =ISTEXT (true) format:
"11/1"
" /2"
" /3"
"12/1"
This format gets converted when the following code runs and I need it to leave Column A of the "TO" alone (don't convert).
Or, convert Col A back to look like its original format shown above...
Does anyone know some code that will convert it back?
Or know how to adjust the current code to - keep it from converting Column A of the "TO" sheet?

Sub Mod_13_TO2BOM()

'Cleans to appropriately allow MATCHING to take place between the 2 sheets w/ the PN#
'========================================================
'Sub Macro1_SelectFullSheet()
'
'
    Sheets("TO").Select
    Cells.Select

'THIS IS CRITICAL CODE!!  IT WILL CLEAN DATA OR ENTIRE SHEET OF DATA THAT HAS BEEN BROUGHT IN FROM AN
'OUTSIDE MAIN FRAME SYSTEM. IT WILL CLEAN EVERYTHING THAT MIGHT PREVENT YOUR LOOK UP MATCHING CODE FROM
'APPROPRIATELY FINDING MATCHES.  To Use: Select data or sheet needing cleaned, then run. (or add the code
'to this code to select desired range)

   
   'David McRitchie 2000-07-03 mod 2002-08-16 2005-09-29 join.htm
   '-- http://www.mvps.org/dmcritchie/excel/join.htm#trimall
   ' - Optionally reenable improperly terminated Change Event macros
   
      Application.DisplayAlerts = True
      Application.EnableEvents = True   'should be part of Change Event macro
   If Application.Calculation = xlCalculationManual Then
      MsgBox "Calculation was OFF will be turned ON upon completion"
   End If
   
   Application.ScreenUpdating = False
   Application.Calculation = xlCalculationManual
   Dim cell As Range
   'Also Treat CHR 0160, as a space (CHR 032)
   Selection.Replace What:=Chr(160), replacement:=Chr(32), _
     lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(13) & Chr(10), replacement:=Chr(32), _
        lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(13), replacement:=Chr(32), _
        lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(21), replacement:=Chr(32), _
        lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   '---------------------------
   Selection.Replace What:=Chr(8), replacement:=Chr(32), _
      lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   Selection.Replace What:=Chr(9), replacement:=Chr(32), _
      lookat:=xlPart, SearchOrder:=xlByRows, MatchCase:=False
   'Trim in Excel removes extra internal spaces, VBA does not
   On Error Resume Next
   For Each cell In Intersect(Selection, _
      Selection.SpecialCells(xlConstants, xlTextValues))
     cell.Value = Application.Trim(cell.Value)
   Next cell
   On Error GoTo 0
   Application.Calculation = xlCalculationAutomatic
   Application.ScreenUpdating = True
'End Sub


'=============================================================
'Sub CompareAndHighlight()

'THIS LOOKS FOR CELLS THAT >>> DO <<< MATCH AND HIGHLIGHTS THEM
'....shows green highlighted rows on the TO so the analyst knows these were found on the BOM and accounted for
'....leaves the items not found with no colorization
'Works GREAT!

    Sheets("TO").Select
    Range("A1").Select

    Dim rng1 As Range, rng2 As Range, k As Integer, j As Integer
    Dim isMatch As Boolean

    For k = 7 To Sheets("TO").Range("B" & Rows.Count).End(xlUp).Row 'START ON ROW 7
        isMatch = True
        Set rng1 = Sheets("TO").Range("B" & k)
        For j = 5 To Sheets("BOM Worksheet").Range("P" & Rows.Count).End(xlUp).Row 'START ON ROW 5
            Set rng2 = Sheets("BOM Worksheet").Range("P" & j)
            If StrComp(Trim(rng1.Text), Trim(rng2.Text), vbTextCompare) = 0 Then
                isMatch = False
                Exit For
            End If
            Set rng2 = Nothing
        Next j


'<<<>>>>THE BELOW SHOWS HOW TO HIGHLIGHT IN 3 DIFFERENT WAYS
'>>>>>>>>>HIGHLIGHT ONLY A CELL
'>>>>>>>>>HIGHLIGHT A ROW TO INFINITY
'>>>>>>>>>HIGHLIGHT A ROW ONLY OUT TO THE END OF WHERE DATA EXISTS

        If Not isMatch Then
            'rng1.Interior.Color = RGB(173, 255, 47) 'THIS ONE highlights ONLY THE CELL
            'rng1.EntireRow.Interior.Color = RGB(173, 255, 47) 'THIS ONE highlights ENTIRE ROW (to infinity)
            With Sheets("TO")
            .Range(.Range("A" & rng1.Row), .Cells(rng1.Row, .Columns.Count).End(xlToLeft)).Interior.Color = RGB(173, 255, 47)
    End With

            'rng1.Value = "Incorrect Name" 'THIS LINE ACTUALLY overwrites the cell with "incorrect name" not sure
            '...............................why anyone would want this - but keeping it in the event I see a need
            
        End If
        Set rng1 = Nothing
    Next k
'End Sub

'====================================================================
'BOTH TO TO BOM AND BOM to TO MODS WORK PERFECTLY ON "12345 TEST" FILE
 'Sub EveryCharacter()

    Sheets("TO").Select
 
    Dim i As Long
    Dim L As Long
    Dim c As Range
    Dim r As String
    Dim rng As Range
'================================================
'THIS IS THE ORIG CODE BUT IT IS NOT WORKING PROPERLY
'THE PROBLEM IS THAT I NEED SEVERAL COLUMNS CLEANED SO A PROPER MATCH CAN TAKE PLACE
'NEED TO CLEAN B AND G OF THE "TO" TAB SO IT CAN COMPARE THOSE TO THE "BOM" TAB

     'Range to search/replace
        Set rng = Range("B8:B5000")
'================================================
'THIS IS THE NEW CODE BUT IT IS CAUSING ERROR ON L=LEN(C) ROW
'COMMENTING IT OUT FOR NOW UNTIL RESOLVED

    'TO DO THE ENTIRE ACTIVE SHEET USE THIS LINE OF CODE INSTEAD:
    'Set rng = ActiveSheet.UsedRange
'================================================
     'Every Cell!
    For Each c In rng
         'Get length of string in cell
        L = Len(c)
         'If blank go next
        If L = 0 Then GoTo phred
         'Every character...
        For i = 1 To L
            r = Mid(c, i, 1)
             'If current char is outside 'normal' ASCII range
            If r < Chr(32) Or r > Chr(126) Then
                 'delete it
                c.Replace What:=r, replacement:="", lookat:=xlPart, _
                SearchOrder:=xlByColumns, MatchCase:=False
            End If
             'else get next character in cell
        Next
phred:
         'Get next cell
    Next c
     
'========================================================
  
    Sheets("TO").Select

Dim x As Range, pnrng As Range, nr As Long
Application.ScreenUpdating = False
With Sheets("TO")
  For Each x In .Range("B7", .Range("B" & Rows.Count).End(xlUp))
    Set pnrng = Sheets("BOM Worksheet").Columns(16).Find(x.Value, lookat:=xlWhole)
    
'IF NO MATCH BETWEEN "B" OF TO AND "P" OF BOM THEN COPY THE "B" PN FROM TO to the base of the BOM
'ALSO COPY THE NOUN "O", THE UPA "E" to the base of the BOM

    If pnrng Is Nothing Then
      nr = Sheets("BOM Worksheet").Range("P" & Rows.Count).End(xlUp).Offset(1).Row
      With Sheets("BOM Worksheet").Range("P" & nr)
        .Value = x.Value
        .Font.FontStyle = "Bold"
        .Font.Color = 255
      End With
      
      With Sheets("BOM Worksheet").Range("O" & nr)
        .Value = x.Offset(, 4).Value
        .Font.FontStyle = "Bold"
        .Font.Color = 255
      End With
      
      With Sheets("BOM Worksheet").Range("E" & nr)
        .Value = x.Offset(, 5).Value
        .Font.FontStyle = "Bold"
        .Font.Color = 255
      End With
      
    End If
  Next x
  
End With
With Sheets("BOM Worksheet")
  .Columns("E:E").AutoFit
  .Columns("O:P").AutoFit
  .Activate
End With
Application.ScreenUpdating = True
End Sub

 

[Jonmo1]

Rather than trying to change it back after it happens...
I would concentrate on preventing it from being changed in the first place.

Try using F8 to step through the code and watch the cells as you go.
And isolate the line or section that is making the change happen.

Then post back and indicate which lines are causing the change.