Skip Row When Column Word Meet

[Gryder]

Hello All,

I have 5 different words in column K (Week, Month, Quarterly, SemiAnnual and Annual.). This information is sent from the 5 separate sheets into one sheet called "All". I have the rows sorted by Week, Month, Quarterly, SemiAnnual and Annual. I would like to place a blank row in between each of the 5 words (Week, Month, Quarterly, SemiAnnual and Annual) Below is a picture of what I would like it to look like. This is just a simple example. Below is my code for the "All" Sheet. Again, i would like to skip a row at the end of each word like week or month.

I do have 2 buttons in the sheet, one named Transfer to move all the weeks, months. . . back to their appropriate sheet and a Sort button that sorts the information coming into the "All" sheet.

Private Sub CommandButton1_Click()

Application.ScreenUpdating = False
Dim i As Long
Dim Lastrow As Long
Dim Lastrowa As Long

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

    For i = Lastrow To 4 Step -1

    If Cells(i, 8) = "Not Due" And Cells(i, 11) = "Week" Then
       Rows(i).Copy Destination:=Sheets("Weekly").Range("A1048576").End(xlUp).Offset(1, 0)
       Rows(i).Delete
      
    ElseIf Cells(i, 8) = "Not Due" And Cells(i, 11) = "Month" Then
        Rows(i).Copy Destination:=Sheets("Monthly").Range("A1048576").End(xlUp).Offset(1, 0)
        Rows(i).Delete
  
    ElseIf Cells(i, 8) = "Not Due" And Cells(i, 11) = "Quart" Then
        Rows(i).Copy Destination:=Sheets("Quarterly").Range("A1048576").End(xlUp).Offset(1, 0)
        Rows(i).Delete
       
       
    ElseIf Cells(i, 8) = "Not Due" And Cells(i, 11) = "SemiAn" Then
        Rows(i).Copy Destination:=Sheets("SemiAnnual").Range("A1048576").End(xlUp).Offset(1, 0)
        Rows(i).Delete
       
       
    ElseIf Cells(i, 8) = "Not Due" And Cells(i, 11) = "Annual" Then
        Rows(i).Copy Destination:=Sheets("Annual").Range("A1048576").End(xlUp).Offset(1, 0)
        Rows(i).Delete
        End If
   
    Next i
Application.ScreenUpdating = True

End Sub

Private Sub CommandButton2_Click()

Application.ScreenUpdating = False

Dim Lastrow As Long

Lastrow = Cells(Rows.Count, "A").End(xlUp).Row

Set wsData = ThisWorkbook.Worksheets("ConMon Due")

Set rngData = wsData.Range("A3:L3" & Lastrow)


rngData.Sort key1:=Range("L4"), order1:=xlAscending, Header:=xlYes

Application.ScreenUpdating = True


End Sub

 

[Joe4]

Just change the row number in this line here:

For r = Range("K" & Rows.Count).End(xlUp).Row To 2 Step -1

to this:

For r = Range("K" & Rows.Count).End(xlUp).Row To 4 Step -1

Note what that is doing, that is looping through your rows backwards, from the also row with data in column K up to row 4.

 

[Gryder]

That makes sense Joe, it's like my other code (For i = Lastrow To 4 Step -1) it's stopping at row 4.

So I tried to do a simple Else statement with a message box if there is a blank row so my code doesn't enter more rows after the first one is inputted. But the Else statement broke the code and I had to close Excel through task manager.

I have a button for the code below and I basically want the code to do nothing after it enters a blank row the first time between the Week, Month, Quarterly, etc.. If the button is pressed again. A message would pop up stating there is already a row there.

Sub CommandButton3_Click()
  Dim r As Long
 
  Application.ScreenUpdating = False
  For r = Range("K" & Rows.Count).End(xlUp).Row To 4 Step -1
    If Range("K" & r).Value <> Range("K" & r + 1).Value Then
        Rows(r + 1).Insert
        Rows(r + 1).Clear
     Else
     MsgBox " There is already a row there"
       
    End If
  Next r
  Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

Rather than stopping at every blank row and reporting that there is a blank, and given that you have said that you are just trying to deal with the situation when the button is clicked again, would this work for you?
I have assumed that the values in column K are not the result of formulas.

Sub CommandButton3_Click()
  Dim r As Long
 
  Application.ScreenUpdating = False
  With Range("K4", Range("K" & Rows.Count).End(xlUp))
    If .SpecialCells(xlConstants).Count = .Rows.Count Then
      For r = .Row + .Rows.Count - 2 To 4 Step -1
        If Range("K" & r).Value <> Range("K" & r + 1).Value Then
          Rows(r + 1).Insert
          Rows(r + 1).Clear
        End If
      Next r
    Else
      MsgBox "Blank rows have already been added"
    End If
  End With
  Application.ScreenUpdating = True
End Sub

 

[Gryder]

That worked Peter, thank you and Joe for helping me out with this.

 

[Peter_SSs]

You are welcome. Glad we got there in the end.