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

 

[Gryder]

Hey Peter_SSs, The code worked and I added a button to it. I noticed when it enters the new row, it also contains the colors from the previous row. How can I remove the colors in the three boxes shown in the photo with the code you provided? Rows D, F and G have colors.

 

[Joe4]

Your original picture did not show any coloring!

The important question is, where is this coloring coming from?
Was it added manually, or is it the result of Conditional Formatting?
The answer to that question might help determine the best way to address it.

 

[Gryder]

It was manually added.

 

[Joe4]

Try this variation of the original to remove all the manually added color fill from the newly inserted rows:

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
        Rows(r + 1).Interior.Pattern = xlNone
    End If
  Next r
  Application.ScreenUpdating = True
End Sub

 

[Peter_SSs]

.. or unless you want those vertical borders also removed so the row looks more clear?

Sub Insert_Blanks_v2()
  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
      Rows(r + 1).Clear
    End If
  Next r
  Application.ScreenUpdating = True
End Sub

 

[Gryder]

This is great Joe and Peter! Both work as expected. This might be the last question, I hope. I should've thought of all the kinks before posting. But I do have a header from rows 1-3. The code moves a row down from 3 and leaves a blank row like in the picture below. Is there a way to not move the row down under the header (row 3). Everything else works as expected after each Week, Month, Quarterly etc. Thanks again for all the help.

Garrett