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

 

[Gryder]

Bump

 

[Gryder]

I put my example in different words, hopefully someone will understand.

How can I make it where it inserts a row only when the first word is found and not all words from using xlUp. below is an example chart. I want to keep all the Weeks, Months, Quarterlies in the same group but I want to separate week from month and month from quarterly. I want the code to look from bottom to top and when it sees the first instant of "Week" put a row underneath and the same for the other words. This code below works, but it search's from top to bottom. I tried getting it to work but I get an error.

This code almost works, it puts a blank row above the word Week. I want to place a blank row below the word Week like in the example above.

Sub InsertRowSearchUp()

    Dim out As Boolean, cl As Range

    Set cl = ActiveSheet.Range("K" & Rows.Count).End(xlUp)    'start cell

    Do Until out                            'initially out=False

        If cl = "Week" Then

            cl.EntireRow.Insert shift:=xlDown

            out = True

        Else

            If cl.Row = 1 Then

                out = True

            Else

                Set cl = cl.Offset(-1)      

            End If

        End If

    Loop

End Sub

 

[Peter_SSs]

When posting vba code in the forum, please use the available code tags. It makes your code much easier to read/debug & copy. My signature block below has more details. I have added the tags for you this time.

I have 5 different words in column K (Week, Month, Quarterly, SemiAnnual and Annual.). ... . 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

Try this with a copy of your data

Sub Insert_Blanks()
  Dim r As Long
  
  Application.ScreenUpdating = False
  For r = Range("K" & Rows.Count).End(xlUp).Row To 2 Step -1
    If Range("K" & r).Value <> Range("K" & r + 1).Value Then Rows(r + 1).Insert
  Next r
  Application.ScreenUpdating = True
End Sub