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 <443e405b$1_1@news.iprimus.com.au>,
"Brad" <bradc2@iprimus.com.au> 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

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" <jemcgimpsey@mvps.org> wrote in message
news:jemcgimpsey-F9F57E.06493213042006@msnews.microsoft.com...
> 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 <443e405b$1_1@news.iprimus.com.au>,
> "Brad" <bradc2@iprimus.com.au> 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

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" <bradc2@iprimus.com.au> wrote in message
news:443ee878_1@news.iprimus.com.au...
> 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" <jemcgimpsey@mvps.org> wrote in message
> news:jemcgimpsey-F9F57E.06493213042006@msnews.microsoft.com...
> > 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 <443e405b$1_1@news.iprimus.com.au>,
> > "Brad" <bradc2@iprimus.com.au> 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
>
>

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" <bob.phillips@notheretiscali.co.uk> wrote in message
news:ur%232Vb6XGHA.4184@TK2MSFTNGP03.phx.gbl...
> 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" <bradc2@iprimus.com.au> wrote in message
> news:443ee878_1@news.iprimus.com.au...
>> 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" <jemcgimpsey@mvps.org> wrote in message
>> news:jemcgimpsey-F9F57E.06493213042006@msnews.microsoft.com...
>> > 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 <443e405b$1_1@news.iprimus.com.au>,
>> > "Brad" <bradc2@iprimus.com.au> 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
>>
>>
>
>

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" <bradc2@iprimus.com.au> wrote in message
news:44403ab1$1_1@news.iprimus.com.au...
> 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" <bob.phillips@notheretiscali.co.uk> wrote in message
> news:ur%232Vb6XGHA.4184@TK2MSFTNGP03.phx.gbl...
> > 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" <bradc2@iprimus.com.au> wrote in message
> > news:443ee878_1@news.iprimus.com.au...
> >> 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" <jemcgimpsey@mvps.org> wrote in message
> >> news:jemcgimpsey-F9F57E.06493213042006@msnews.microsoft.com...
> >> > 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 <443e405b$1_1@news.iprimus.com.au>,
> >> > "Brad" <bradc2@iprimus.com.au> 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
> >>
> >>
> >
> >
>
>