ExcelBanter - Executing macro on cell change.

ExcelBanter (https://www.excelbanter.com/)

- Excel Programming (https://www.excelbanter.com/excel-programming/)

- - Executing macro on cell change. (https://www.excelbanter.com/excel-programming/358798-executing-macro-cell-change.html)

Executing macro on cell change.

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

Executing macro on cell change.

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" wrote in message
...
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

Executing macro on cell change.

If I understand you correctly:

Private Sub Workbook_SheetChange( _
ByVal Sh As Object, ByVal Target As Excel.Range)
Dim vSubs As Variant
Dim sTemp As String
Dim i As Long
With Target
If .Count 1 Then Exit Sub
If .Column = 1 Then
If IsNumeric(.Value) Then
sTemp = CStr(Int(.Value * 100))
vSubs = Array( _
"Z", "A", "B", "C", "D", "E", "F", "G", "H", "I")
For i = 1 To Len(sTemp)
Mid(sTemp, i, 1) = vSubs(CLng(Mid(sTemp, i, 1)))
Next i
On Error Resume Next
Application.EnableEvents = False
.Value = sTemp
Application.EnableEvents = True
On Error GoTo 0
Else
MsgBox "Non numeric value in cell"
End If
End If
End With
End Sub

In article ,
"Brad" wrote:

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

Executing macro on cell change.

Hi,

Thanks, this is great. Though I don't get how it works?

2 minor issues are - I would like to keep the original number entered in A
column, and have the 'code' for it placed in the B column. The other is how
do I specify which column is the column to read from and which is the column
to write too. EG: I might put my numbers in the H column and want the code
written to the I column?

Thanks again.
Brad.

"JE McGimpsey" wrote in message
...
If I understand you correctly:

Private Sub Workbook_SheetChange( _
ByVal Sh As Object, ByVal Target As Excel.Range)
Dim vSubs As Variant
Dim sTemp As String
Dim i As Long
With Target
If .Count 1 Then Exit Sub
If .Column = 1 Then
If IsNumeric(.Value) Then
sTemp = CStr(Int(.Value * 100))
vSubs = Array( _
"Z", "A", "B", "C", "D", "E", "F", "G", "H", "I")
For i = 1 To Len(sTemp)
Mid(sTemp, i, 1) = vSubs(CLng(Mid(sTemp, i, 1)))
Next i
On Error Resume Next
Application.EnableEvents = False
.Value = sTemp
Application.EnableEvents = True
On Error GoTo 0
Else
MsgBox "Non numeric value in cell"
End If
End If
End With
End Sub

In article ,
"Brad" wrote:

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

Executing macro on cell change.

This writes to the next column.

The target column is picked out with this cod

If .Column = 1 Then

change the number to whicehever column that you want

Private Sub Workbook_SheetChange( _
ByVal Sh As Object, ByVal Target As Excel.Range)
Dim vSubs As Variant
Dim sTemp As String
Dim i As Long
With Target
If .Count 1 Then Exit Sub
If .Column = 1 Then
If IsNumeric(.Value) Then
sTemp = CStr(Int(.Value * 100))
vSubs = Array( _
"Z", "A", "B", "C", "D", "E", "F", "G", "H", "I")
For i = 1 To Len(sTemp)
Mid(sTemp, i, 1) = vSubs(CLng(Mid(sTemp, i, 1)))
Next i
On Error Resume Next
Application.EnableEvents = False
.offset(0,1).Value = sTemp
Application.EnableEvents = True
On Error GoTo 0
Else
MsgBox "Non numeric value in cell"
End If
End If
End With
End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Brad" wrote in message
...
Hi,

Thanks, this is great. Though I don't get how it works?

2 minor issues are - I would like to keep the original number entered in A
column, and have the 'code' for it placed in the B column. The other is
how
do I specify which column is the column to read from and which is the
column
to write too. EG: I might put my numbers in the H column and want the
code
written to the I column?

Thanks again.
Brad.

"JE McGimpsey" wrote in message
...
If I understand you correctly:

Private Sub Workbook_SheetChange( _
ByVal Sh As Object, ByVal Target As Excel.Range)
Dim vSubs As Variant
Dim sTemp As String
Dim i As Long
With Target
If .Count 1 Then Exit Sub
If .Column = 1 Then
If IsNumeric(.Value) Then
sTemp = CStr(Int(.Value * 100))
vSubs = Array( _
"Z", "A", "B", "C", "D", "E", "F", "G", "H", "I")
For i = 1 To Len(sTemp)
Mid(sTemp, i, 1) = vSubs(CLng(Mid(sTemp, i, 1)))
Next i
On Error Resume Next
Application.EnableEvents = False
.Value = sTemp
Application.EnableEvents = True
On Error GoTo 0
Else
MsgBox "Non numeric value in cell"
End If
End If
End With
End Sub

In article ,
"Brad" wrote:

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

Executing macro on cell change.

Thanks Again Bob!

I really appreciate your help. And I think I learnt something, which is
always good. One last question, how would you make the code recognise
autofilling of cells. (eg: Selecting A1:A10 - typing 12.95 - CTRL / Enter)
and filling down of cells. (eg: Typing 12.95 into A1, grabing it's bottom
righthand corner and dragging it to A10)?

Thanks
Brad.

"Bob Phillips" wrote in message
...
This writes to the next column.

The target column is picked out with this cod

If .Column = 1 Then

change the number to whicehever column that you want

Private Sub Workbook_SheetChange( _
ByVal Sh As Object, ByVal Target As Excel.Range)
Dim vSubs As Variant
Dim sTemp As String
Dim i As Long
With Target
If .Count 1 Then Exit Sub
If .Column = 1 Then
If IsNumeric(.Value) Then
sTemp = CStr(Int(.Value * 100))
vSubs = Array( _
"Z", "A", "B", "C", "D", "E", "F", "G", "H", "I")
For i = 1 To Len(sTemp)
Mid(sTemp, i, 1) = vSubs(CLng(Mid(sTemp, i, 1)))
Next i
On Error Resume Next
Application.EnableEvents = False
.offset(0,1).Value = sTemp
Application.EnableEvents = True
On Error GoTo 0
Else
MsgBox "Non numeric value in cell"
End If
End If
End With
End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Brad" wrote in message
...
Hi,

Thanks, this is great. Though I don't get how it works?

2 minor issues are - I would like to keep the original number entered in
A
column, and have the 'code' for it placed in the B column. The other is
how
do I specify which column is the column to read from and which is the
column
to write too. EG: I might put my numbers in the H column and want the
code
written to the I column?

Thanks again.
Brad.

"JE McGimpsey" wrote in message
...
If I understand you correctly:

Private Sub Workbook_SheetChange( _
ByVal Sh As Object, ByVal Target As Excel.Range)
Dim vSubs As Variant
Dim sTemp As String
Dim i As Long
With Target
If .Count 1 Then Exit Sub
If .Column = 1 Then
If IsNumeric(.Value) Then
sTemp = CStr(Int(.Value * 100))
vSubs = Array( _
"Z", "A", "B", "C", "D", "E", "F", "G", "H",
"I")
For i = 1 To Len(sTemp)
Mid(sTemp, i, 1) = vSubs(CLng(Mid(sTemp, i, 1)))
Next i
On Error Resume Next
Application.EnableEvents = False
.Value = sTemp
Application.EnableEvents = True
On Error GoTo 0
Else
MsgBox "Non numeric value in cell"
End If
End If
End With
End Sub

In article ,
"Brad" wrote:

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

Executing macro on cell change.

Here is the code Brad.

I have coded it so that if you try to do it on multiple columns, it exits
out. I have also added a constant defining the target column to ease
maintenance

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Excel.Range)
Const WS_COL As Long = 1
Dim vSubs As Variant
Dim sTemp As String
Dim i As Long
Dim cell As Range
With Target
If .Columns.Count 1 Then Exit Sub
If .Column = WS_COL Then
For Each cell In Target
If IsNumeric(cell.Value) Then
sTemp = CStr(Int(cell.Value * 100))
vSubs = Array( _
"Z", "A", "B", "C", "D", "E", "F", "G", "H",
"I")
For i = 1 To Len(sTemp)
Mid(sTemp, i, 1) = vSubs(CLng(Mid(sTemp, i, 1)))
Next i
On Error Resume Next
Application.EnableEvents = False
cell.Offset(0, 1).Value = sTemp
Application.EnableEvents = True
On Error GoTo 0
Else
MsgBox "Non numeric value in cell"
End If
Next cell
End If
End With
End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Brad" wrote in message
...
Thanks Again Bob!

I really appreciate your help. And I think I learnt something, which is
always good. One last question, how would you make the code recognise
autofilling of cells. (eg: Selecting A1:A10 - typing 12.95 - CTRL /
Enter)
and filling down of cells. (eg: Typing 12.95 into A1, grabing it's bottom
righthand corner and dragging it to A10)?

Thanks
Brad.

"Bob Phillips" wrote in message
...
This writes to the next column.

The target column is picked out with this cod

If .Column = 1 Then

change the number to whicehever column that you want

Private Sub Workbook_SheetChange( _
ByVal Sh As Object, ByVal Target As Excel.Range)
Dim vSubs As Variant
Dim sTemp As String
Dim i As Long
With Target
If .Count 1 Then Exit Sub
If .Column = 1 Then
If IsNumeric(.Value) Then
sTemp = CStr(Int(.Value * 100))
vSubs = Array( _
"Z", "A", "B", "C", "D", "E", "F", "G", "H", "I")
For i = 1 To Len(sTemp)
Mid(sTemp, i, 1) = vSubs(CLng(Mid(sTemp, i, 1)))
Next i
On Error Resume Next
Application.EnableEvents = False
.offset(0,1).Value = sTemp
Application.EnableEvents = True
On Error GoTo 0
Else
MsgBox "Non numeric value in cell"
End If
End If
End With
End Sub

--
HTH

Bob Phillips

(remove nothere from email address if mailing direct)

"Brad" wrote in message
...
Hi,

Thanks, this is great. Though I don't get how it works?

2 minor issues are - I would like to keep the original number entered
in
A
column, and have the 'code' for it placed in the B column. The other
is
how
do I specify which column is the column to read from and which is the
column
to write too. EG: I might put my numbers in the H column and want the
code
written to the I column?

Thanks again.
Brad.

"JE McGimpsey" wrote in message
...
If I understand you correctly:

Private Sub Workbook_SheetChange( _
ByVal Sh As Object, ByVal Target As Excel.Range)
Dim vSubs As Variant
Dim sTemp As String
Dim i As Long
With Target
If .Count 1 Then Exit Sub
If .Column = 1 Then
If IsNumeric(.Value) Then
sTemp = CStr(Int(.Value * 100))
vSubs = Array( _
"Z", "A", "B", "C", "D", "E", "F", "G", "H",
"I")
For i = 1 To Len(sTemp)
Mid(sTemp, i, 1) = vSubs(CLng(Mid(sTemp, i,
1)))
Next i
On Error Resume Next
Application.EnableEvents = False
.Value = sTemp
Application.EnableEvents = True
On Error GoTo 0
Else
MsgBox "Non numeric value in cell"
End If
End If
End With
End Sub

In article ,
"Brad" wrote:

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