Moving Entire Row at the bottom of the page.

[TryingBest]

Hi,
I am new to this amazing forum where great help is offered.
I wanted to move an entire row at the bottom of the page based on a specific word/criteria match in a column. I found this piece of code and implemented it, which works great.
But, running into an issue, if the word is not matched it gives a debug error - rather than moving on to the next search item in the list.

I am very much new to this coding/VBA, so asking for help. Code is pasted below.
If 'abc' is not in column C, it gives an error and not moving on to the next item 'xyz'

Sub MoveRows()
   Dim rng As Range
   With Range("C:C")
      .Replace "abc", "=Xabx", xlWhole, , False, , False, False
      Set rng = .SpecialCells(xlFormulas, xlErrors)
      .Replace "=Xabc", "abc", xlWhole, , False, , False, False
      rng.EntireRow.Copy Range("A" & Rows.Count).End(xlUp).Offset(2)
      rng.EntireRow.Delete
   End With
  
   With Range("C:C")
      .Replace "xyz", "=Xxyz", xlWhole, , False, , False, False
      Set rng = .SpecialCells(xlFormulas, xlErrors)
      .Replace "=Xxyz", "xyz", xlWhole, , False, , False, False
      rng.EntireRow.Copy Range("A" & Rows.Count).End(xlUp).Offset(2)
      rng.EntireRow.Delete
   End With
  
End Sub

 

[RobP]

ok, great - so you don't need to replace any text. On that basis, let me propose you a new routine, which will search Col C for your matching text (I have "baa" in there at the moment - but you change to what you want. Be sure in both places in this routine to use the asterisks before and after your text ("*baa*"). Once it calculates how many instances there are in Col.C, it will copy paste them 2 rows below and delete the original row.

Sub searchtext_move_rows()

Dim x, lastrow As Long


lastrow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row 'get last row of data in Col C
x = WorksheetFunction.CountIf(Columns(3), "*baa*") 'count how many "baa" instances there are first. Use * wildcards around the text


Range("C1").Activate 'place cursor at start of data rows.

For I = 1 To x 'we know how many instances there are, so lets get all of them only.

    Columns(3).Find(what:="*baa*", After:=Range("C1"), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate ' search in column 3 (C) for baa
      
    ActiveCell.EntireRow.Copy Range("A" & Rows.Count).End(xlUp).Offset(2)
    ActiveCell.EntireRow.Delete
         
Next I


End Sub

 

[RobP]

actually, sorry, this one will solve the multiple gaps in the rows at the bottom if you wanted the data to copy to consecutive rows. If you want to keep the offset, use the previous code.

Sub searchtext_move_rows()

Dim x, lastrow As Long


lastrow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row + 1 'get last row of data in Col C,
x = WorksheetFunction.CountIf(Columns(3), "*baa*") 'count how many "baa" instances there are first. Use * wildcards around the text


Range("C1").Activate 'place cursor at start of data rows.

For I = 1 To x 'we know how many instances there are, so lets get all of them only.

    Columns(3).Find(what:="*baa*", After:=Range("C1"), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate ' search in column 1 (A) for baa
        
    ActiveCell.EntireRow.Copy Range("A" & lastrow + 1)
    ActiveCell.EntireRow.Delete
    
Next I


End Sub

 

[TryingBest]

actually, sorry, this one will solve the multiple gaps in the rows at the bottom if you wanted the data to copy to consecutive rows. If you want to keep the offset, use the previous code.

Sub searchtext_move_rows()

Dim x, lastrow As Long


lastrow = ActiveSheet.Range("C" & Rows.Count).End(xlUp).Row + 1 'get last row of data in Col C,
x = WorksheetFunction.CountIf(Columns(3), "*baa*") 'count how many "baa" instances there are first. Use * wildcards around the text


Range("C1").Activate 'place cursor at start of data rows.

For I = 1 To x 'we know how many instances there are, so lets get all of them only.

    Columns(3).Find(what:="*baa*", After:=Range("C1"), LookIn:=xlFormulas, _
    LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
    MatchCase:=False, SearchFormat:=False).Activate ' search in column 1 (A) for baa
       
    ActiveCell.EntireRow.Copy Range("A" & lastrow + 1)
    ActiveCell.EntireRow.Delete
   
Next I


End Sub

Hi Rob,

Thanks a ton!
This indeed was the actual requirement!


Thanks again

 

[RobP]

you're welcome, glad to have solved this issue for you.

thanks for the feedback
Rob