Try this
Sub Code()
On Error GoTo ws_exit
Application.EnableEvents = True
Application.ScreenUpdating = False
Cells(1, 1).Select
Do While Not IsEmpty(ActiveCell)
CellNum = ActiveCell.Value
CellLength = Len(CellNum)
CellVal = Empty
If IsNumeric(CellNum) Then
CellNum = CellNum * 100
Else
Application.ScreenUpdating = True
Err = MsgBox(" Non numeric value in cell?", vbOKCancel)
If Err = vbCancel Then End
End If
Application.ScreenUpdating = False
For i = 1 To CellLength
If Mid(CellNum, i, 1) = 1 Then CellVal = CellVal & "A"
If Mid(CellNum, i, 1) = 2 Then CellVal = CellVal & "B"
If Mid(CellNum, i, 1) = 3 Then CellVal = CellVal & "C"
If Mid(CellNum, i, 1) = 4 Then CellVal = CellVal & "D"
If Mid(CellNum, i, 1) = 5 Then CellVal = CellVal & "E"
If Mid(CellNum, i, 1) = 6 Then CellVal = CellVal & "F"
If Mid(CellNum, i, 1) = 7 Then CellVal = CellVal & "G"
If Mid(CellNum, i, 1) = 8 Then CellVal = CellVal & "H"
If Mid(CellNum, i, 1) = 9 Then CellVal = CellVal & "I"
If Mid(CellNum, i, 1) = 0 Then CellVal = CellVal & "Z"
Next
ActiveCell.Offset(0, 1).Value = CellVal
ActiveCell.Offset(1, 0).Select
Loop
ws_exit:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
--
HTH
Bob Phillips
(remove nothere from email address if mailing direct)
"Brad" <bradc2@iprimus.com.au> wrote in message
news:443e405b$1_1@news.iprimus.com.au...
> Hi,
>
> I have the following code which I would like to execute each after a
change
> is made to any cell in column A. Only trouble is if I place it in a
> "Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)" sub, it
> gets locked in an endless loop. Does anyone have any suggestions?
>
> ___
>
> Sub Code()
> Application.ScreenUpdating = False
> Cells(1, 1).Select
> Do While Not IsEmpty(ActiveCell)
> CellNum = ActiveCell.Value
> CellLength = Len(CellNum)
> CellVal = Empty
> If IsNumeric(CellNum) Then
> CellNum = CellNum * 100
> Else
> Application.ScreenUpdating = True
> Err = MsgBox(" Non numeric value in cell?", vbOKCancel)
> If Err = vbCancel Then End
> End If
> Application.ScreenUpdating = False
> For i = 1 To CellLength
> If Mid(CellNum, i, 1) = 1 Then CellVal = CellVal & "A"
> If Mid(CellNum, i, 1) = 2 Then CellVal = CellVal & "B"
> If Mid(CellNum, i, 1) = 3 Then CellVal = CellVal & "C"
> If Mid(CellNum, i, 1) = 4 Then CellVal = CellVal & "D"
> If Mid(CellNum, i, 1) = 5 Then CellVal = CellVal & "E"
> If Mid(CellNum, i, 1) = 6 Then CellVal = CellVal & "F"
> If Mid(CellNum, i, 1) = 7 Then CellVal = CellVal & "G"
> If Mid(CellNum, i, 1) = 8 Then CellVal = CellVal & "H"
> If Mid(CellNum, i, 1) = 9 Then CellVal = CellVal & "I"
> If Mid(CellNum, i, 1) = 0 Then CellVal = CellVal & "Z"
> Next
>
> ActiveCell.Offset(0, 1).Value = CellVal
> ActiveCell.Offset(1, 0).Select
> Loop
> Application.ScreenUpdating = True
> End Sub
>
>
>
Bookmarks