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]

Hi,
does this cure your issue please ?

thanks
Rob

Sub MoveRows()
Dim rng As Range
With Range("C:C")
.Replace "abc", "=Xabx", xlWhole, , False, , False, False
On Error Resume Next
Set rng = .SpecialCells(xlFormulas, xlErrors)
    If Not rng Is Nothing Then
        .Replace "=Xabc", "abc", xlWhole, , False, , False, False
        rng.EntireRow.Copy Range("A" & Rows.Count).End(xlUp).Offset(2)
        rng.EntireRow.Delete
    End If
End With

 

[mumps]

It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).

 

[TryingBest]

Hi,
does this cure your issue please ?

thanks
Rob

Sub MoveRows()
Dim rng As Range
With Range("C:C")
.Replace "abc", "=Xabx", xlWhole, , False, , False, False
On Error Resume Next
Set rng = .SpecialCells(xlFormulas, xlErrors)
    If Not rng Is Nothing Then
        .Replace "=Xabc", "abc", xlWhole, , False, , False, False
        rng.EntireRow.Copy Range("A" & Rows.Count).End(xlUp).Offset(2)
        rng.EntireRow.Delete
    End If
End With

Hi,
does this cure your issue please ?

thanks
Rob

Sub MoveRows()
Dim rng As Range
With Range("C:C")
.Replace "abc", "=Xabx", xlWhole, , False, , False, False
On Error Resume Next
Set rng = .SpecialCells(xlFormulas, xlErrors)
    If Not rng Is Nothing Then
        .Replace "=Xabc", "abc", xlWhole, , False, , False, False
        rng.EntireRow.Copy Range("A" & Rows.Count).End(xlUp).Offset(2)
        rng.EntireRow.Delete
    End If
End With

Hi @RobP
Thank you so much. Works like a charm!

If I may ask for another help, as I just trying to automate my Excel reports. Again I have code that, was searched and implemented.

Code is for cutting and pasting the entire rows to another sheet once the criteria are matched.
The issue here is Worksheet, where the row is to be pasted, that WorksheetSheet has to be already created. Code does not create/add a new sheet on its own.

I tried with add sheet command, but that only adds the sheet to the WB, and then the code does not function.


Sub Sort_service_Affecting()
Dim SrchTerm As String, EndRw As Long, Rw As Long

EndRw = Cells(Rows.Count, "A").End(xlUp).Row
SrchTerm = "xyz"
For Rw = 2 To EndRw
If InStr(Cells(Rw, "A").Value, SrchTerm) Then
With Cells(Rw, "A").Resize(, 18)
.Copy Sheets("Sorted").Cells(Rows.Count, "A").End(xlUp)(2)
.Delete Shift:=xlUp

End With
Rw = Rw - 1
End If
Next Rw
End Sub

 

[RobP]

Hi, I think what you are experiencing is that when you "create" (or add) your new worksheet to your workbook, that sheet becomes the "Active" worksheet. So the rest of your code is trying to operate then on this new blank worksheet.

Try adding

Worksheets("your worksheet name here").Activate

after you have created the sheet, but before you execute the rest of your code. This should ensure your code is operating on your correct data, and not on the "Sorted" sheet you have just created.
cheers
Rob

 

[TryingBest]

Hi, I think what you are experiencing is that when you "create" (or add) your new worksheet to your workbook, that sheet becomes the "Active" worksheet. So the rest of your code is trying to operate then on this new blank worksheet.

Try adding

Worksheets("your worksheet name here").Activate

after you have created the sheet, but before you execute the rest of your code. This should ensure your code is operating on your correct data, and not on the "Sorted" sheet you have just created.
cheers
Rob

Hi Rob,
Thanks again! It works. But, Now I have run into another issue.

I have multiple tabs, this code needs to run. So, for Sheet1, this works fine. But, When I got to sheet2 .. It creates another Blank TAB.

So, Is it possible not to hardcode the sheet name? and to let the code know, Sheet is already there, just cut and paste the rows there.

TIA.

 

[RobP]

Hi,

Do you mean you want to run this routine on several sheet Tabs ? In this case, the statement above is what you need - you just have to hardcode your "Worksheet or Tabname" into it and ensure its activated before you run it on that particular sheet.

If I've not understood well, then perhaps this function can be useful for you - to first detect if a sheet exists or not before you run something on it ?
You can call it by simply asking

If SheetExists("your sheet name here") Then
Do your stuff
Endif

Private Function SheetExists(Tabname) As Boolean
'   Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(Tabname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
End Function

 

[TryingBest]

Hi,

Do you mean you want to run this routine on several sheet Tabs ? In this case, the statement above is what you need - you just have to hardcode your "Worksheet or Tabname" into it and ensure its activated before you run it on that particular sheet.

If I've not understood well, then perhaps this function can be useful for you - to first detect if a sheet exists or not before you run something on it ?
You can call it by simply asking

If SheetExists("your sheet name here") Then
Do your stuff
Endif

Private Function SheetExists(Tabname) As Boolean
'   Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(Tabname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
End Function

Hi .. Sorry, didn't get your point here.

Once the new sheet is added, I need to run this code on multiple sheets in a wb. So, every time I try to run this code on sheet2, it stops as 'myNewSheet' is already created, and Active Sheet changes to Sheet1 .. as this is hardcoded.

Sub Sort_Not_Required()

'I have added new Sheet
Sheets.Add.Name = "myNewSheet"

' I don't want to hard code this "Sheet1" here. As in wb, I will run this code on Sheet1, Sheet2, and so on. So every time Sheet value changes.
Worksheets("Sheet1").Activate


Dim SrchTerm As String, EndRw As Long, Rw As Long
EndRw = Cells(Rows.Count, "A").End(xlUp).row
SrchTerm = "abc"
For Rw = 2 To EndRw
If InStr(Cells(Rw, "A").Value, SrchTerm) Then
With Cells(Rw, "A").Resize(, 18)
.Copy Sheets("myNewSHeet").Cells(Rows.Count, "A").End(xlUp)(2)
.Delete Shift:=xlUp
End With
Rw = Rw - 1
End If
Next Rw
End sub

 

[RobP]

Hi, heres the update - see if it is okay for you. Note, I also added the function "Sheetexists" that I posted previously, as this is used to check if your "myNewSheet" exists or not. If it does not exist, then it will create a new one. the second time (sheet2 for example), it should not create one.
Let me know how you get on.

Sub Sort_Not_Required()

Dim sheetname As String
sheetname = ActiveSheet.Name 'store the current sheetname before adding a sheet.

If Not SheetExists("myNewSheet") Then
    'I have added new Sheet if one does not exist already (uses the sheetexists function below)
    Sheets.Add.Name = "myNewSheet"
    ' hardcoded sheetname removed, and variable name used instead from above
    Worksheets(sheetname).Activate
End If

Dim SrchTerm As String, EndRw As Long, Rw As Long

EndRw = Cells(Rows.Count, "A").End(xlUp).Row
SrchTerm = "abc"
For Rw = 2 To EndRw
    If InStr(Cells(Rw, "A").Value, SrchTerm) Then
        With Cells(Rw, "A").Resize(, 18)
            .Copy Sheets("myNewSHeet").Cells(Rows.Count, "A").End(xlUp)(2)
            .Delete Shift:=xlUp
        End With
        Rw = Rw - 1
    End If
Next Rw

End Sub

Private Function SheetExists(Tabname) As Boolean
'   Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(Tabname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
End Function

 

[TryingBest]

Hi, heres the update - see if it is okay for you. Note, I also added the function "Sheetexists" that I posted previously, as this is used to check if your "myNewSheet" exists or not. If it does not exist, then it will create a new one. the second time (sheet2 for example), it should not create one.
Let me know how you get on.

Sub Sort_Not_Required()

Dim sheetname As String
sheetname = ActiveSheet.Name 'store the current sheetname before adding a sheet.

If Not SheetExists("myNewSheet") Then
    'I have added new Sheet if one does not exist already (uses the sheetexists function below)
    Sheets.Add.Name = "myNewSheet"
    ' hardcoded sheetname removed, and variable name used instead from above
    Worksheets(sheetname).Activate
End If

Dim SrchTerm As String, EndRw As Long, Rw As Long

EndRw = Cells(Rows.Count, "A").End(xlUp).Row
SrchTerm = "abc"
For Rw = 2 To EndRw
    If InStr(Cells(Rw, "A").Value, SrchTerm) Then
        With Cells(Rw, "A").Resize(, 18)
            .Copy Sheets("myNewSHeet").Cells(Rows.Count, "A").End(xlUp)(2)
            .Delete Shift:=xlUp
        End With
        Rw = Rw - 1
    End If
Next Rw

End Sub

Private Function SheetExists(Tabname) As Boolean
'   Returns TRUE if sheet exists in the active workbook
    Dim x As Object
    On Error Resume Next
    Set x = ActiveWorkbook.Sheets(Tabname)
    If Err = 0 Then SheetExists = True _
        Else SheetExists = False
End Function

Hi Rob,

Sorry for the late reply. I tried this code but doesn't work. It creates the new Tab "myNewSheet" but, then the code stops functioning there.
Also, Please share how to incorporate this private function in the main SUB, as this returns an error.