Can anyone help with the following?

I have a spreadsheet of approximately 15000 records where the information
has been captured incorrectly.
This needs to be Split into its own rows based on an "LO" reference number.

The field it looks at can have several types of input.
|reference number is 123456LO|
|REFERENCE NUMBER IS 123456LO AND 123457LO|
|REFERENCE NUMBER IS 123456LO23456LO AND 112233LO|

The above works fine until it encounters the following.

Line 1 | 123456LO 123457LO - 123458LO |
Line 2 | TEXT TEXT TEXT TEXT TEXT TEXT TEXT TEXT 999999LO TEXT|

The output always go wrong with the above in cell F1 and F2

Can anyone help with this?

Thanks In Advance!

I think I'd just go through that array and look for numbers at the end:

Option Explicit
Sub test_v1()

Dim lRow As Long
Dim iRow As Long
Dim mySplit As Variant
Dim UsedLOs As Variant
Dim LOCtr As Long
Dim sCtr

lRow = Range("F" & Rows.Count).End(xlUp).Row

For iRow = lRow To 2 Step -1
If InStr(1, Cells(iRow, 6).Value, "LO") 0 Then
mySplit = Split(Cells(iRow, 6), "LO")
UsedLOs = mySplit
LOCtr = -1
For sCtr = LBound(mySplit) To UBound(mySplit)
If IsNumeric(Right(mySplit(sCtr), 6)) Then
LOCtr = LOCtr + 1
UsedLOs(LOCtr) = Right(mySplit(sCtr), 6) & "LO"
End If
Next sCtr

If LOCtr -1 Then
ReDim Preserve UsedLOs(LBound(UsedLOs) To LOCtr)
If LOCtr 0 Then
Rows(iRow + 1).Resize(LOCtr).Insert
Rows(iRow + 1).Resize(LOCtr, 5).Value _
= Rows(iRow).Resize(1, 5).Value
End If
Cells(iRow, 6).Resize(LOCtr + 1, 1).Value _
= Application.Transpose(UsedLOs)
End If
End If
Next
End Sub

williamC wrote:

Can anyone help with the following?

I have a spreadsheet of approximately 15000 records where the information
has been captured incorrectly.
This needs to be Split into its own rows based on an "LO" reference number.

The field it looks at can have several types of input.
|reference number is 123456LO|
|REFERENCE NUMBER IS 123456LO AND 123457LO|
|REFERENCE NUMBER IS 123456LO23456LO AND 112233LO|

Code:

 
 Sub test_v1()
     Dim lRow    As Long
     Dim i       As Long, x
 
     lRow = Range("F" & Rows.Count).End(xlUp).Row
 
     For i = lRow To 2 Step -1
         If InStr(1, Cells(i, 6).Value, "LO")  0 Then
             x = Split(Cells(i, 6), "LO")
             Rows(i + 1 & ":" & i + UBound(x) - 1).Insert
             Range(Cells(i, 1), Cells(i + UBound(x) - 1, 5)).FillDown
             Cells(i, 6) = Right(x(0), 6) & "LO"
             For j = 1 To UBound(x) - 1
                 Cells(i + j, 6) = Trim(Right(x(j), 6)) & "LO"
             Next
         End If
     Next
 End Sub

The above works fine until it encounters the following.

Line 1 | 123456LO 123457LO - 123458LO |
Line 2 | TEXT TEXT TEXT TEXT TEXT TEXT TEXT TEXT 999999LO TEXT|

The output always go wrong with the above in cell F1 and F2

Can anyone help with this?

Thanks In Advance!

--

Dave Peterson