macro skipping last loop in loop

Question

I have column with blank cell, zero value and non-zero value. what I am doing is I am finding non-zero value first, copying first and then going to next cell where cell is not blank, if the cell is not blank then I'm adding row above that non-blank cell and pasting the cell value into added row's H column. my code is skipping last loop.

Sub CopyNonZeroValuesAndInsertRows()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim i As Long

    ' Set the worksheet variable to the active sheet
    Set ws = ActiveSheet

    ' Find the last used row in column A (assuming data starts in the first row)
    lastRow = ws.Cells(ws.Rows.Count, "K").End(xlUp).Row

    ' Loop through each row starting from the first row
    For i = 3 To lastRow
        ' Check if the value is non-zero
        If ws.Cells(i, "K").Value <> 0 Then
            ' Find the next row with a non-empty value
            Dim nextRow As Long
            nextRow = i + 1
            Do While nextRow <= lastRow And IsEmpty(ws.Cells(nextRow, "K").Value)
                nextRow = nextRow + 1
            Loop

            ' Insert a row above the next row and paste the non-zero value in column H
            If nextRow <= lastRow Then
                ws.Rows(nextRow & ":" & nextRow).Insert Shift:=xlDown
                ws.Cells(nextRow, "I").Value = ws.Cells(i, "K").Value
            End If
            
            ' Move to the next row
            i = i + 1
        End If
    Next i
End Sub 

can someone help ? below is my code

Answer 1

• Please share your data layout if it is not your exptected output.
• You may need code to add a boarder for the last inserted row.

Option Explicit
Sub CopyNonZeroValuesAndInsertRows()
    Dim oSht As Worksheet
    Dim lastRow As Long
    Dim i As Long
    Dim lastVal, iVal, bFirst As Boolean
    Const START_ROW = 3
    Set oSht = ActiveSheet
    lastRow = oSht.Cells(oSht.Rows.Count, "K").End(xlUp).Row
    i = START_ROW
    bFirst = True
    Do While i <= lastRow + 1
        iVal = oSht.Cells(i, "K").Value
        If iVal <> 0 And (Not IsEmpty(iVal)) Or i = lastRow + 1 Then
            If bFirst Then
                lastVal = oSht.Cells(i, "K").Value
                bFirst = False
            Else
                oSht.Rows(i).Insert Shift:=xlDown
                oSht.Cells(i, "I").Resize(1, 3).Interior.Color = vbYellow ' for testing
                oSht.Cells(i, "I").Value = lastVal
                lastVal = oSht.Cells(i + 1, "K").Value
                i = i + 1
            End If
        End If
        lastRow = oSht.Cells(oSht.Rows.Count, "K").End(xlUp).Row
        i = i + 1
    Loop
End Sub