vzachin
06-20-2008, 10:43 AM
hi
i need help to modify the code in the following post
http://www.vbaexpress.com/forum/showthread.php?t=17086
i need to go down column B and remove any character that is not an alpha (chr 65-90) or numeric (chr 48-57) .
keep all the data in column b
Sub doit()
Dim mr As Range
Dim mycell As Range
Dim RgRif As Range
Dim mytext As String, newtext As String
Dim i As Integer, j As Integer
mytext = "*/-;,."
Set mr = Range("a5:" & Range("a6500").End(xlUp).Address)
For Each mycell In mr
If Not IsNumeric(mycell.Offset(0, 1).Value) Then
For i = 1 To Len(mytext)
If InStr(1, mycell.Offset(0, 1), Mid(mytext, i, 1)) > 0 Then
Set RgRif = Range("e65000").End(xlUp).Offset(1, 0)
RgRif.Value = mycell.Value
RgRif.Offset(0, 1).Value = mycell.Offset(0, 1).Value
For j = 1 To Len(mytext)
On Error Resume Next
newtext = Replace(RgRif.Offset(0, 1).Value, Mid(mytext, i, 1), "")
On Error GoTo 0
RgRif.Offset(0, 2).Value = newtext
Next j
Exit For
End If
Next i
End If
Next mycell
End Sub
thanks
zach
i need help to modify the code in the following post
http://www.vbaexpress.com/forum/showthread.php?t=17086
i need to go down column B and remove any character that is not an alpha (chr 65-90) or numeric (chr 48-57) .
keep all the data in column b
Sub doit()
Dim mr As Range
Dim mycell As Range
Dim RgRif As Range
Dim mytext As String, newtext As String
Dim i As Integer, j As Integer
mytext = "*/-;,."
Set mr = Range("a5:" & Range("a6500").End(xlUp).Address)
For Each mycell In mr
If Not IsNumeric(mycell.Offset(0, 1).Value) Then
For i = 1 To Len(mytext)
If InStr(1, mycell.Offset(0, 1), Mid(mytext, i, 1)) > 0 Then
Set RgRif = Range("e65000").End(xlUp).Offset(1, 0)
RgRif.Value = mycell.Value
RgRif.Offset(0, 1).Value = mycell.Offset(0, 1).Value
For j = 1 To Len(mytext)
On Error Resume Next
newtext = Replace(RgRif.Offset(0, 1).Value, Mid(mytext, i, 1), "")
On Error GoTo 0
RgRif.Offset(0, 2).Value = newtext
Next j
Exit For
End If
Next i
End If
Next mycell
End Sub
thanks
zach