LinkBack URL
About LinkBacks
Guest 
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
>
>
Register To Reply
Bookmarks