VBA help to insert rows etc

[philcart]

Hi,
I’d appreciate guidance please, on coding the following in an Excel 2007 workbook –
While there is data in col B, work down col K starting from K2
If K2 is blank, move to K3, and so on
When you come to a nonblank cell in col K, let’s use K5 as an example, check the LEN
If Len(K5) = 11, then insert one blank row under row 5, and copy values from cells C5 to J5 into the newly inserted C6 to J6. Copy K5 into B6
If LEN(K5) = 23, then insert TWO blank rows under row 5, and copy values from cells C5 to J5 into the newly inserted C6 to J6, and C7 to J7. Copy LEFT(K5,11) into B6, and Copy RIGHT(K5,11) into B7
If LEN(K5) = 35, then insert THREE blank rows under row 5, and copy values from cells C5 to J5 into the newly inserted C6 to J6, C7 to J7, and C8 to J8. Copy LEFT(K5,11) into B6, copy MID(K5,13,11) into B7 and copy RIGHT(K5,11) into B8.
As ever, all help gratefully received.
Cheers,
Phil

 

[id107]

This should work. Try it out on a copy of your workbook

Sub Philcart()
 
    Dim lr As Long, i As Long
 
    lr = Range("B" & Rows.Count).End(xlUp).Row
 
    For i = lr To 2 Step -1
        Select Case Len(Range("K" & i).Value)
            Case 11
                Rows(i + 1).Insert
                With Range("C" & i + 1 & ":J" & i + 1)
                    .Formula = "=C" & i
                    .Value = .Value
                End With
                Range("B" & i + 1).Value = Range("K" & i).Value
            Case 23
                Rows(i + 1 & ":" & i + 2).Insert
                With Range("C" & i + 1 & ":J" & i + 2)
                    .Formula = "=C" & i
                    .Value = .Value
                End With
                Range("B" & i + 1).Value = Left(Range("K" & i).Value, 11)
                Range("B" & i + 2).Value = Right(Range("K" & i).Value, 11)
            Case 35
                Rows(i + 1 & ":" & i + 3).Insert
                With Range("C" & i + 1 & ":J" & i + 3)
                    .Formula = "=C" & i
                    .Value = .Value
                End With
                Range("B" & i + 1).Value = Left(Range("K" & i).Value, 11)
                Range("B" & i + 2).Value = Mid(Range("K" & i).Value, 13, 11)
                Range("B" & i + 3).Value = Right(Range("K" & i).Value, 11)
        End Select
    Next i
 
End Sub

 

[philcart]

Fantastic! Does exactly what I need.

Very many thanks for the super quick respone.

Cheers,

Phil