-
Just combine into single sub
[VBA]
Sub drv()
Dim rCell As Range
Application.ScreenUpdating = False
For Each rCell In Selection.Cells
With rCell
.Offset(0, 1).NumberFormat = "@"
If Right(.Value, 6) Like "[!0-9][0-9][0-9][0-9][0-9][0-9]" Then
.Offset(0, 1).Value = Right(.Value, 5)
.Value = Left(.Value, Len(.Value) - 5)
ElseIf Right(.Value, 11) Like "[!0-9][0-9][0-9][0-9][0-9][0-9][-][0-9][0-9][0-9][0-9]" Then
.Offset(0, 1).Value = Right(.Value, 10)
.Value = Left(.Value, Len(.Value) - 10)
ElseIf Right(.Value, 10) Like "[!0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]" Then
.Offset(0, 1).Value = Mid(.Value, Len(.Value) - 8, 5) & "-" & Right(.Value, 4)
.Value = Left(.Value, Len(.Value) - 9)
Else
.Offset(0, 1).Value = vbNullString
End If
End With
Next
Application.ScreenUpdating = True
End Sub
[/VBA]
Paul
Posting Permissions
- You may not post new threads
- You may not post replies
- You may not post attachments
- You may not edit your posts
-
Forum Rules