VBA Inserting rows based on Column criteria

[RoosterBull]

I really would appreciate help with my VBA coding as I've been struggling with it for days without a positive solution. It's pointless to show what I have managed thus far, although could be comical to some expert coders.
Based on the value of entire Column "J", I need the VBA to insert rows totaling to "10" when "J" is a "4" including those cells in "J" that are a "4".
At the same time, I require all "10" rows in column "C" to be merged and to resize the Row Height to "11"
I have uploaded an image of before running the VBA macro and the desired result after.
I really hope someone can help. Thanking you in advance.

 

[myall_blues]

Does this work for you?

Sub insertRows()
    Dim lastRow As Long, i As Long, j As Long, cRow As Long, insertRows As Long
    '
    lastRow = Range("J" & Rows.Count).End(xlUp).Row
    For i = lastRow To 1 Step -1
        If Range("J" & i).Value = 4 Then
            j = 0
            cRow = i
            While Range("J" & i).Value = 4
                j = j + 1
                i = i - 1
            Wend
            insertRows = 10 - j
            Range("J" & cRow).Offset(1).Resize(insertRows).EntireRow.Insert
            Range("C" & cRow - j + 1 & ":C" & cRow - j + 10).Merge
            Rows(cRow - j + 1 & ":" & cRow - j + 10).RowHeight = 11
        End If
    Next
End Sub

 

[RoosterBull]

Does this work for you?

Sub insertRows()
    Dim lastRow As Long, i As Long, j As Long, cRow As Long, insertRows As Long
    '
    lastRow = Range("J" & Rows.Count).End(xlUp).Row
    For i = lastRow To 1 Step -1
        If Range("J" & i).Value = 4 Then
            j = 0
            cRow = i
            While Range("J" & i).Value = 4
                j = j + 1
                i = i - 1
            Wend
            insertRows = 10 - j
            Range("J" & cRow).Offset(1).Resize(insertRows).EntireRow.Insert
            Range("C" & cRow - j + 1 & ":C" & cRow - j + 10).Merge
            Rows(cRow - j + 1 & ":" & cRow - j + 10).RowHeight = 11
        End If
    Next
End Sub

 

[RoosterBull]

Does this work for you?

Sub insertRows()
    Dim lastRow As Long, i As Long, j As Long, cRow As Long, insertRows As Long
    '
    lastRow = Range("J" & Rows.Count).End(xlUp).Row
    For i = lastRow To 1 Step -1
        If Range("J" & i).Value = 4 Then
            j = 0
            cRow = i
            While Range("J" & i).Value = 4
                j = j + 1
                i = i - 1
            Wend
            insertRows = 10 - j
            Range("J" & cRow).Offset(1).Resize(insertRows).EntireRow.Insert
            Range("C" & cRow - j + 1 & ":C" & cRow - j + 10).Merge
            Rows(cRow - j + 1 & ":" & cRow - j + 10).RowHeight = 11
        End If
    Next
End Sub

Hi myall_blues
Thank you very much, it works perfectly thank you very much.
You have saved me much frustration and I wish I had posed earlier.........So many hours trying and failing all the time.

 

[myall_blues]

You're welcome and thanks for the feedback. I'm glad we could help.