Home Menu

Menu


ExcelBanter » Excel Newsgroups » Excel Programming > Executing macro on cell change.
Reply
 
LinkBack Thread Tools Search this Thread Display Modes
  #1   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 8
Default 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



Reply With QuoteReply With Quote
  #2   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,272
Default 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





Reply With QuoteReply With Quote
  #3   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 4,624
Default 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
Reply With QuoteReply With Quote
  #4   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 8
Default 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


Reply With QuoteReply With Quote
  #5   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,272
Default 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




Reply With QuoteReply With Quote
  #6   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 8
Default 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






Reply With QuoteReply With Quote
  #7   Report Post  
Posted to microsoft.public.excel.programming
external usenet poster
  
Posts: 11,272
Default 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








Reply With QuoteReply With Quote
Reply
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes
Hybrid Mode Hybrid Mode

Posting Rules
Smilies are On
[IMG] code is On
HTML code is Off
Trackbacks are On
Pingbacks are On
Refbacks are On

Similar Threads
Thread Thread Starter Forum Replies Last Post
executing a macro within another brian Excel Discussion (Misc queries) 3 July 5th 06 01:22 AM
Executing a macro from a cell filo666 Excel Discussion (Misc queries) 2 February 15th 05 08:18 PM
finding the first blank cell and then executing rest of macro Ed[_25_] Excel Programming 1 December 13th 04 07:24 PM
What macro is executing? Ken Loomis Excel Programming 3 October 13th 04 05:39 AM
executing a macro from within a cell kduntley Excel Programming 2 May 13th 04 05:38 PM


All times are GMT +1. The time now is 02:34 AM.

Powered by vBulletin® Copyright ©2000 - 2025, Jelsoft Enterprises Ltd.
Copyright ©2004-2025 ExcelBanter.
The comments are property of their posters.
 

About Us

"It's about Microsoft Excel"

 

Contact Us ExcelBanter forum home Privacy Statement