How to insert a blank row based on cell value

March 22, 2022

i have been trying to get success on the below vba script but still no luck, my objective is to lookup for cell values in column (C) and insert a blank row just above the cell value if it doesnt have a "dot"/".", for instance – if cell C2 does not have a "." then it should create a blank row just above that

Sub testing()

Dim col As Variant
Dim lr As Long
Dim i As Long
Dim startRow As Long

col = "C"
startRow = 2
lr = Cells(Rows.Count, col).End(xlUp).Row

With ActiveSheet
For i = lr To startRow Step -1
If IsNumeric(Range("E2", "E" & lr).Value) = True Then
.Cells(i + 1, col).EntireRow.Insert shift:=xlUp
End If
Next i
End With

End Sub

Input

Desired Output

>Solution :

A slightly different approach where the insert happens at the end:

Sub Tester()

    Dim c As Range, rng As Range, ws As Worksheet, v
    
    Set ws = ActiveSheet
    
    For Each c In ws.Range("C2:C" & ws.Cells(Rows.Count, "C").End(xlUp).Row).Cells
        v = c.Value
        If InStr(v, ".") = 0 And Len(v) > 0 Then    'has a value, with no "." ?
            If rng Is Nothing Then                  'any previous cells found?
                Set rng = c                         'start the range with `c`
            Else
                Set rng = Application.Union(c, rng) 'add `c` to `rng`
            End If
        End If
    Next c
    'if found any cells then do the insert
    If Not rng Is Nothing Then rng.EntireRow.Insert shift:=xlDown
End Sub