Excel-Adjust Current Code to Move Rows to New Sheet Before Deletion I have a mac
ID: 3571005 • Letter: E
Question
Excel-Adjust Current Code to Move Rows to New Sheet Before Deletion
I have a macro that has a section that deletes rows where column E contains specific words as part of the cell value. Currently it is set to delete these rows. Can a line be added to move the rows to a new sheet called 'Staff Data' before they are deleted from the 'Roster Data' sheet.
I was playing around with adding a line like RowstoDelete.entirerow. copy Destination:=Sheets("Staff Data") but must be missing something or holiday craziness is stopping my brain from working. :)
'Deletes non-SEP and chairperson rows
Dim z As Long
Dim FoundRowToDelete As Boolean
Dim OriginalCalculationMode As Long
Dim RowsToDelete As Range
Dim SearchItems() As String
Dim DataStartRow As Long
Dim SearchColumn As String
Dim SheetName As String
' Choose the row you want the search and delete to start on
' Choose the column to search and delete to use for deletion
' Choose the sheet in the workbook you want this macro to be run on
DataStartRow = 2
SearchColumn = "E"
SheetName = "Roster Data"
' Enter the terms you want to be used for criteria for deletion
' All terms entered below are CASE SENSITIVE and need to be
'separated by a comma
SearchItems = Split("Assistant, Admin, Representative, Officer", ",")
With Worksheets(SheetName)
LastRow = .Cells(.Rows.Count, SearchColumn).End(xlUp).Row
For x = LastRow To DataStartRow Step -1
FoundRowToDelete = False
For z = 0 To UBound(SearchItems)
If InStr(.Cells(x, SearchColumn).Value, SearchItems(z)) Then
FoundRowToDelete = True
Exit For
End If
Next
If FoundRowToDelete Then
If RowsToDelete Is Nothing Then
Set RowsToDelete = .Cells(x, SearchColumn)
Else
Set RowsToDelete = Union(RowsToDelete, .Cells(x, SearchColumn))
End If
If RowsToDelete.Areas.Count > 100 Then
RowsToDelete.EntireRow.Delete
Set RowsToDelete = Nothing
End If
End If
Next
End With
If Not RowsToDelete Is Nothing Then
RowsToDelete.EntireRow.Delete
End If
Thanks !
Explanation / Answer
Hi..
Hi,
I had to DIM a few variables to test this on my machine; I use Option Explicit, so if you've dimmed them elsewhere you may get a duplicate variable declaration so just delete my dims. changes are in bold.
Just a point I don't understand in this code. In this line
SearchItems = Split("Assistant, Admin, Representative, Officer", ",")
You have a space in front of items 2,3 and 4. This means that the code won't find (say) 'Representative' it will onlt find <Space>Representative
Is this deliberate?
Sub somesub()
'Deletes non-SEP and chairperson rows
Dim z As Long
Dim FoundRowToDelete As Boolean
Dim OriginalCalculationMode As Long
Dim RowsToDelete As Range
Dim SearchItems() As String
Dim DataStartRow As Long
Dim SearchColumn As String
Dim SheetName As String
Dim DstShtName As String
Dim LastRow As Long, x As Long
' Choose the row you want the search and delete to start on
' Choose the column to search and delete to use for deletion
' Choose the sheet in the workbook you want this macro to be run on
DataStartRow = 2
SearchColumn = "E"
SheetName = "Roster Data"
DstShtName = "Staff Data"
' Enter the terms you want to be used for criteria for deletion
' All terms entered below are CASE SENSITIVE and need to be
'separated by a comma
SearchItems = Split("Assistant, Admin, Representative, Officer", ",")
With Worksheets(SheetName)
LastRow = .Cells(.Rows.Count, SearchColumn).End(xlUp).Row
For x = LastRow To DataStartRow Step -1
FoundRowToDelete = False
For z = 0 To UBound(SearchItems)
If InStr(.Cells(x, SearchColumn).Value, SearchItems(z)) Then
FoundRowToDelete = True
Exit For
End If
Next
If FoundRowToDelete Then
If RowsToDelete Is Nothing Then
Set RowsToDelete = .Cells(x, SearchColumn)
Else
Set RowsToDelete = Union(RowsToDelete, .Cells(x, SearchColumn))
End If
If RowsToDelete.Areas.Count > 100 Then
RowsToDelete.EntireRow.Delete
Set RowsToDelete = Nothing
End If
End If
Next
End With
If Not RowsToDelete Is Nothing Then
LastRow = Sheets(DstShtName).Cells(Rows.Count, SearchColumn).End(xlUp).Row
RowsToDelete.EntireRow.Copy Sheets(DstShtName).Cells(LastRow + 1, 1)
RowsToDelete.EntireRow.Delete
End If
End Sub
Related Questions
Navigate
Integrity-first tutoring: explanations and feedback only — we do not complete graded work. Learn more.