M
Marcus Ostman
Hi!
Can anyone tell me whats wrong with these two macros? Or help me with
a better one. Im trying to split the data in all cells in one column,
both these macros only work on the first row.
/Marcus
The data im trying to split:
Q1517A#ABB
C5686B#ABB
C5687C#ABB
350544-B21
344257-B21
Sub Split1()
Dim selectie As Range
Dim cel As Range
On Error Resume Next
Set selectie = Range(ActiveCell.Address & "," _
& Selection.Address).SpecialCells(xlCellTypeConstants,
xlTextValues)
If selectie Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each cel In selectie
ActiveCell.Offset(0, 1) = Left(ActiveCell, _
Application.WorksheetFunction.Find("#", ActiveCell) - 1)
ActiveCell.Offset(0, 2) = Right(ActiveCell, _
Application.WorksheetFunction.Find("#", ActiveCell) - 3)
Next cel
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Split2()
For Each c In Columns(ActiveCell.Column).Cells 'Alla rader i aktuell
column
If Not IsEmpty(c.Value) Then
ActiveCell.Offset(0, 1) = Left(ActiveCell, _
Application.WorksheetFunction.Find("#", ActiveCell) - 1)
ActiveCell.Offset(0, 2) = Right(ActiveCell, _
Application.WorksheetFunction.Find("#", ActiveCell) - 3)
End If
Next c
End Sub
Can anyone tell me whats wrong with these two macros? Or help me with
a better one. Im trying to split the data in all cells in one column,
both these macros only work on the first row.
/Marcus
The data im trying to split:
Q1517A#ABB
C5686B#ABB
C5687C#ABB
350544-B21
344257-B21
Sub Split1()
Dim selectie As Range
Dim cel As Range
On Error Resume Next
Set selectie = Range(ActiveCell.Address & "," _
& Selection.Address).SpecialCells(xlCellTypeConstants,
xlTextValues)
If selectie Is Nothing Then Exit Sub
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each cel In selectie
ActiveCell.Offset(0, 1) = Left(ActiveCell, _
Application.WorksheetFunction.Find("#", ActiveCell) - 1)
ActiveCell.Offset(0, 2) = Right(ActiveCell, _
Application.WorksheetFunction.Find("#", ActiveCell) - 3)
Next cel
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
Sub Split2()
For Each c In Columns(ActiveCell.Column).Cells 'Alla rader i aktuell
column
If Not IsEmpty(c.Value) Then
ActiveCell.Offset(0, 1) = Left(ActiveCell, _
Application.WorksheetFunction.Find("#", ActiveCell) - 1)
ActiveCell.Offset(0, 2) = Right(ActiveCell, _
Application.WorksheetFunction.Find("#", ActiveCell) - 3)
End If
Next c
End Sub