Start on the cell you want to change. I have not tested it completely, but it
comes close. Little late maybe I will have a chance to look at it again
tomorrow. Hope it helps.
Sub Macro1()
y = Len(ActiveCell.Value)
AllCharacters = ActiveCell.Value
ReturnAddress = ActiveCell.Address
z = 1
Do Until z = y + 1
ReplaceString = Mid(AllCharacters, z, 1)
Dim Msg, Style, Title, Response
Msg = "Keep this character " & ReplaceString
Style = vbYesNo
Title = "Keep Character?"
Response = MsgBox(Msg, Style, Title)
If Response = vbYes Then
' Do nothing
Stop
Else
' Change or delete character
FrontString = Left(AllCharacters, z - 1)
FrontMid = Mid(AllCharacters, z, y - z)
BackString = Right(AllCharacters, y - z)
Dim Message1, Title1, Default1, MyValue1
Message1 = "Please enter the replacement value"
Title1 = "Replacement value"
Default1 = " "
MyValue1 = InputBox(Message1, Title1, Default1)
AllCharacters = FrontString & MyValue1 & BackString
Stop
End If
z = z + 1
Loop
ActiveCell.Value = AllCharacters
End Sub