I have the two Macro's which filters a worksheet column by date and then delete's the irrelevant columns.
However, it is very buggy and I need some help to correct that please.
This is what the second Macro is supposed to do:
1) Simply delete the visible rows after the filter is applied, except the first row (headers) - Currently, it deletes ALL visible rows including the first row, even though I have the Offset function in my code.
2) Remove all filters - This is working fine now
Sub DeleteVisibleRows()
Dim ws1 As Worksheet
Dim WorkRng As Range
Set ws1 = ActiveWorkbook.Sheets("Consolidated")
On Error Resume Next
Set WorkRng = Application.Selection
Application.ScreenUpdating = False
With ws1
WorkRng.Offset(1, 0).Rows.SpecialCells(xlCellTypeVisible).EntireRow.Delete
ws1.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
SpecialCells will work like the previous answer.
Sub Button1_Click()
Dim sh As Worksheet, rng As Range, LstRw As Long
Set sh = Sheets("Sheet1")
With sh
LstRw = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = .Range("A2:A" & LstRw).SpecialCells(xlCellTypeVisible)
rng.EntireRow.Delete
.AutoFilterMode = False
End With
End Sub
Deleting rows of filtered data is something I needed time to time while working with tables in excel, but I could never trust a macro when it comes to deleting important stuff. If you still want to use it, this might work for you:
Sub DeleteVisibleRows()
Dim ws As Worksheet
Dim lastrow As Long, i As Long
Set ws = ThisWorkbook.Worksheets("Consolidated")
With ws
lastrow = .Cells(.Rows.Count, "B").End(xlUp).Row
For i = lastrow To 2 Step -1 'To 2 Assuming first row contains headers
If .Rows(i).Hidden = False Then
.Rows(i).Delete
End If
Next
.ShowAllData 'remove filtered data
End With
End Sub
If you're using SELECTION there's no need to define the worksheet. Everything you need is relevant to your selection - your selection may not be on the Consolidated worksheet, it will always be on the parent object of your selection though.
The code below assumes you have a filter applied - if it isn't then everything below the heading gets deleted.
Public Sub DeleteVisibleRows()
Dim WorkRng As Range
Set WorkRng = Selection
With WorkRng
.Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
WorkRng.Parent.AutoFilterMode = False
End Sub
Edit: That code's too long, I'll get rid of some of the junk.
Public Sub DeleteVisibleRows()
With Selection
.Offset(1, 0).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.Parent.AutoFilterMode = False
End With
End Sub
Related
I have been an Excel-user for decades by now, VBA has been "out there" but nothing I've spent much time on in the past. Only minor alterations on existing scripts etc.
However I wanted to increase my knowledge and after about a month of tutorials, googling and more googling I feel that I'm getting a slight grip on the case.
I have a large workbook with many products, including specs, pricing and assorted calculation. When a products expires I'd like to move it to a EOL-sheet so I keep a log of old products.
Currently, this script is as far as I have come. It should look at the selected rows, and move the content to sheet "EOL" and delete it from the original sheet, and skip all hidden rows.
It works well if I select one cell, however if I select more cells, it doesn't correctly iterate through the full range.
Sub MoveRows()
Call SpeedUp
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim LastRow As Long
Dim rng As Range
Set rng = Selection
Set SouceSheet = ActiveSheet
Set TargetSheet = ActiveWorkbook.Sheets("EOL")
TargetRow = ActiveCell.row
LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "D").End(xlUp).row + 1
For Each row In rng.Rows
If row.Rows.Hidden Then
TargetRow = TargetRow + 1
Else
ActiveSheet.Rows(TargetRow).Copy
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormulasAndNumberFormats
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormats
Rows(TargetRow).EntireRow.Delete
LastRow = LastRow + 1
End If
Next row
Call SpeedDown
End Sub
*Note: the SpeedUp/SpeedDown function is to turn of screnupdating etc for efficiency. Doesn't affect the script itself. *
As I tested it commenting out the delete function, it copied the first cell repeatedly, obviously since TargetRow didn't change. When I added TargetRow = TargetRow + 1 after the End If it works flawlessly.
However, when I uncomment the delete part, it doesn't work as I would expect.
As TargetRow is deleted, then I would think that the next row would be the new TargetRow, but it seems like this doesn't happen.
I guess my problem is that there is no direct link between TargetRow and the iteration of rng.Rows, but how can I solve this?
Is there a way to store all the moved rows in a list and subsequently delete them through a new iteration ? Or maybe that is a bit too "python-thinking" for VBA .. ?
Appreciate all input on this probably fairly newbie question :)
You're use a For Each, but you hardly ever use row except for when you want to check if it's hidden. Why do you need TargetRow at all? Try:
For Each row In rng.Rows
If Not row.Rows.Hidden Then
row.Copy
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormulasAndNumberFormats
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormats
row.EntireRow.Delete
LastRow = LastRow + 1
End If
Next row
Move Visible Rows of the Selection
BTW, if you would have used Option Explicit, it would have warned you about the undeclared variable row and the typo in Set SouceSheet = ActiveSheet.
The Row property usually uses the capital letter R. In your code, there are occurrences of .row because you are using a variable named row. To make the case of the property capital again, declare Dim Row As Range. Then you could use another variable name instead of Row e.g. rrg (Row Range), srrg...
Option Explicit
Sub MoveRows()
If Selection Is Nothing Then Exit Sub ' no visible workbooks open
If Not TypeOf Selection Is Range Then Exit Sub ' not a range
Dim sws As Worksheet: Set sws = Selection.Worksheet
Dim srg As Range: Set srg = Intersect(Selection.EntireRow, sws.UsedRange)
If srg Is Nothing Then Exit Sub ' not in rows of the used range
Dim svrg As Range
On Error Resume Next
Set svrg = srg.SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If svrg Is Nothing Then Exit Sub ' no visible cells
Dim dws As Worksheet
On Error Resume Next
Set dws = sws.Parent.Sheets("EOL")
On Error GoTo 0
If dws Is Nothing Then Exit Sub ' worksheet 'EOL' doesn't exist
Dim dfcell As Range
With dws.UsedRange
Set dfcell = dws.Cells(.Row + .Rows.Count, "A")
End With
Application.ScreenUpdating = False
svrg.Copy
dfcell.PasteSpecial xlPasteFormulasAndNumberFormats
dfcell.PasteSpecial xlPasteFormats
svrg.Delete xlShiftUp
Application.ScreenUpdating = True
MsgBox "Rows moved.", vbInformation
End Sub
UPDATE *
So after lots of time spent I did finally get to a solution which does the trick.
Sub MoveRows()
Dim SourceSheet As Worksheet
Dim TargetSheet As Worksheet
Dim rng As Range
Dim TargetRow As Integer
Dim StartRow As Integer
Dim EndRow As Integer
Dim LastRow As Long
Set rng = Selection
Set SourceSheet = ActiveSheet
Set TargetSheet = ActiveWorkbook.Sheets("EOL")
LastRow = TargetSheet.Cells(TargetSheet.Rows.Count, "D").End(xlUp).row + 1
StartRow = rng.row
EndRow = rng.Rows.Count + StartRow - 1
For i = EndRow To StartRow Step -1
If Not Rows(i).Hidden Then
ActiveSheet.Rows(i).Copy
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormulasAndNumberFormats
TargetSheet.Rows(LastRow).PasteSpecial xlPasteFormats
Rows(i).EntireRow.Delete
LastRow = LastRow + 1
End If
Next i
Cells(EndRow, 1).Select
End Sub
Thanks to all for the help!
I am looking for a code to get the name of the last added sheet to Excel.
I have tried this...
Sub test()
Dim lastAddedSheet As Worksheet
Dim oneSheet As Worksheet
With ThisWorkbook
Set lastAddedSheet = .Sheets(1)
For Each oneSheet In .Sheets
If Val(Mid(oneSheet.CodeName, 6)) > Val(Mid(lastAddedSheet.CodeName, 6)) Then
Set lastAddedSheet = oneSheet
End If
Next oneSheet
End With
MsgBox lastAddedSheet.Name & " was last added."
End Sub
But it does not really work.
You can't reliably know what sheet was last added, because a sheet can be inserted before or after any existing sheet in a workbook, see Sheets.Add documentation.
Unless you're the one adding it. In which case, all you need to do is capture the Worksheet object returned by the Add method:
Dim newSheet As Worksheet
Set newSheet = wb.Worksheets.Add
Debug.Print newSheet.Name
Extracting the digits from the CodeName isn't going to be reliable either - especially if you assume that every sheet's code name begins with 5 letters. On a German machine, the CodeName of what we see as Sheet1 would be Tabelle1 - but then again the role of that digit is strictly to ensure uniqueness of the names of the VBComponent items in the VBA project, and none of it says it has anything to do with any sort of ordering.
As per #MathieuGuindon his answer, I can't think of any "simple" way to safely return the name of the latest added sheet. However if you willing to sacrifice some designated space in your project to store CodeNames you could try to utilize the Workbook_NewSheet event.
Private Sub Workbook_NewSheet(ByVal Sh As Object)
Dim lr As Long
With Sheets("Blad1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
.Cells(lr, 1) = ActiveSheet.CodeName
End With
End Sub
Obviously you need to optimize this to add names when adding sheets during runtime. In this simplified example I manually added the existing sheet "Blad1", and upon adding new sheets, the list grew.
When deleting you can utilize the SheetBeforeDelete event, like so:
Private Sub Workbook_SheetBeforeDelete(ByVal Sh As Object)
Dim ws As Object
Dim lr As Long, x As Long
Dim rng1 As Range, rng2 As Range, cl As Range
With Sheets("Blad1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row + 1
Set rng1 = .Range("A2:A" & lr)
For Each ws In ActiveWindow.SelectedSheets
For Each cl In rng1
If cl = ws.CodeName Then
If Not rng2 Is Nothing Then
Set rng2 = Union(rng2, cl)
Else
Set rng2 = cl
End If
End If
Next cl
Next ws
End With
If Not rng2 Is Nothing Then
rng2.Delete
End If
End Sub
Now to get the latest added sheet we can refer to the last cell in our designated range:
Sub LastAdded()
Dim lr As Long
With ThisWorkbook.Sheets("Blad1")
lr = .Cells(.Rows.Count, "A").End(xlUp).Row
Debug.Print "Last added sheet is codenamed: " & .Cells(lr, 1)
End With
End Sub
My take on it is that it would be safest to use the CodeName since they are least likely to get changed and are unique. We can also safely keep using our rng variable since there will always be at least one worksheet in your project (and that might just be the designated one if you protect it). Working in this project will now keep track of latest added worksheet.
Sheets could be a Chart or a Worksheet.
You could try use Worksheets instead of Sheets in your code.
sub test()
Dim lastAddedSheet As Worksheet
Dim oneSheet As Worksheet
With ThisWorkbook
Set lastAddedSheet = .WorkSheets(1)
For Each oneSheet In .WorkSheets
If Val(Mid(oneSheet.CodeName, 6)) > Val(Mid(lastAddedSheet.CodeName, 6)) Then
Set lastAddedSheet = oneSheet
End If
Next oneSheet
End With
MsgBox lastAddedSheet.Name & " was last added."
End Sub
I run my VBA code and the first time it runs I get the result I want but if I run it a second time my column headers get deleted. FYI my table starts on E and goes through N. My button is on column O and also gets deleted when I run it a second time.
Switching the Range did not help and setting AutoFilter to false also did not work.
#
Sub Auto_filter()
Dim sh As Worksheet
Set sh = ThisWorkbook.Worksheets("HP Service Manager")
sh.AutoFilterMode = False
With sh
On Error Resume Next
.ShowAllData
.Range("E1:N1").AutoFilter 1, "IM*"
AutoFilter = False
End With
End Sub
#
Expect to not have column headers deleted.
The issue is in the second code you shared.
The code is first setting the range here:
Set Rng = Range("E1", Cells(iRow, "E"))
And then here it is trying to delete all visible cells in the range (after applying the filter)
Rng.SpecialCells(xlCellTypeVisible).EntireRow.Delete
which also includes your header cell.
So, a simple way to deal with it could be to set another range like this
Set Rng2 = Range("E2", Cells(iRow, "E"))
and then using it to delete the data
Rng2.SpecialCells(xlCellTypeVisible).EntireRow.Delete
Here is the re-written function for your reference. This only deletes the rows starting from row 2 that are blank. You may want to add some error handing in case there are no blank rows to delete etc.
Sub DeleteRowsAll()
Dim iRow As Long
Dim Rng As Range
Application.ScreenUpdating = False
Rows(1).Insert
Range("E1").Value = "rabbitohs"
With ActiveSheet
.UsedRange
iRow = .Cells.SpecialCells(xlCellTypeLastCell).Row
Set Rng = Range("E1", Cells(iRow, "E"))
Rng.AutoFilter Field:=1, Criteria1:=""
Set Rng2 = Range("E2", Cells(iRow, "E"))
Rng2.SpecialCells(xlCellTypeVisible).EntireRow.Delete
.UsedRange
End With
End Sub
Sub DeleteRowsAll()
Dim LastRow As Long
Dim CellValue As String
LastRow = Worksheets("HP Service Manager").Cells(Rows.Count, "E").End(xlUp).Row
For i = LastRow To 2 Step -1
CellValue = Worksheets("HP Service Manager").Cells(i, "E").Value
If CellValue = "" Then
Worksheets("HP Service Manager").Rows(i).Delete
End If
Next i
End Sub
I have the following code which should simply select a range of rows and delete them. Unfortunately it deletes the headers as well, no matter how I change the range.
I tried to change the "rng" parameter without success.
Thank you for the feedback you can provide.
Sub delete_rows_range()
'Application.ScreenUpdating = False
Dim rng, Rng_del As Range
Dim leg As Range
Set leg = Worksheets("Sheet1").Range("aB1")
Set rng = Worksheets("Sheet1").Range("b1")
If Worksheets("Sheet1").AutoFilterMode = True Then
Worksheets("Sheet1").AutoFilter.ShowAllData
End If
rng.Select
rng.AutoFilter Field:=2, Criteria1:=leg
'rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.delete
rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Select
Worksheets("Sheet1").AutoFilterMode = False
End Sub
Your problem is that you are using a single cell as the range.
When you .Offset a single cell range, then use `xlCelTypeVisible.EntireRow.Delete
Excel selects every cell on the sheet and deletes them.
You really should clarify your range with a properly defined range object. e.g.
Dim ws As Worksheet, lRow As Long, rng As Range
Set ws = Worksheets("Sheet1")
lRow = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set rng = ws.Range("A1:AB" & lRow)
But if you want to use B1 as your rng you can replace your line, rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Select with this line...
rng.Range(Cells(2, 2), Cells(rng.Rows.Count, 2)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
You are trying to select from a single cell range.
You should do instead:
Sub delete_rows_range()
'Application.ScreenUpdating = False
Dim rng, Rng_del As Range
Dim leg As Range
Set leg = Worksheets("Sheet1").Range("AB1")
Set rng = Worksheets("Sheet1").Range("B1")
If Worksheets("Sheet1").AutoFilterMode = True Then
Worksheets("Sheet1").AutoFilter.ShowAllData
End If
rng.Select
rng.AutoFilter Field:=2, Criteria1:=leg
'rng.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.delete
Worksheets("Sheet1").UsedRange.SpecialCells(xlCellTypeVisible).Rows(2).Select
Worksheets("Sheet1").AutoFilterMode = False
End Sub
I have an excel workbook, in worksheet1 in Column A, IF the value of that column = ERR I want it to be deleted (the entire row), how is that possible?
PS: keep in mind that I have never used VBA or Macros before, so detailed description is much appreciated.
Using an autofilter either manually or with VBA (as below) is a very efficient way to remove rows
The code below
Works on the entire usedrange, ie will handle blanks
Can be readily adpated to other sheets by changing strSheets = Array(1, 4). ie this code currently runs on the first and fourth sheets
Option Explicit
Sub KillErr()
Dim ws As Worksheet
Dim lRow As Long
Dim lngCol As Long
Dim rng1 As Range
Dim strSheets()
Dim strws As Variant
strSheets = Array(1, 4)
For Each strws In strSheets
Set ws = Sheets(strws)
lRow = ws.Cells.Find("*", , xlValues, , xlByRows, xlPrevious).Row
lngCol = ws.Cells.Find("*", , xlValues, , xlByColumns, xlPrevious).Column
Application.ScreenUpdating = False
ws.Rows(1).Insert
Set rng1 = ws.Range(ws.Cells(1, lngCol), ws.Cells(lRow + 1, lngCol))
With rng1.Offset(0, 1)
.FormulaR1C1 = "=RC1=""ERR"""
.AutoFilter Field:=1, Criteria1:="TRUE"
.EntireRow.Delete
On Error Resume Next
.EntireColumn.Delete
On Error GoTo 0
End With
Next
Application.ScreenUpdating = True
End Sub
sub delete_err_rows()
Dim Wbk as Excel.workbook 'create excel workbook object
Dim Wsh as worksheet ' create excel worksheet object
Dim Last_row as long
Dim i as long
Set Wbk = Thisworkbook ' im using thisworkbook, assuming current workbook
' if you want any other workbook just give the name
' in invited comma as "workbook_name"
Set Wsh ="sheetname" ' give the sheet name here
Wbk.Wsh.activate
' it means Thisworkbook.sheets("sheetname").activate
' here the sheetname of thisworkbook is activated
' or if you want looping between sheets use thisworkbook.sheets(i).activate
' put it in loop , to loop through the worksheets
' use thisworkbook.worksheets.count to find number of sheets in workbook
Last_row = ActiveSheet.Cells(Rows.count, 1).End(xlUp).Row 'to find the lastrow of the activated sheet
For i = lastrow To 1 step -1
if activesheet.cells(i,"A").value = "yourDesiredvalue"
activesheet.cells(i,"A").select ' select the row
selection.entirerow.delete ' now delete the entire row
end if
Next i
end sub
Note any operations that you do using activesheet , will be affected on the currently activated sheet
As your saying your a begginner, why dont you record a macro and check out, Thats the greatest way to automate your process by seeing the background code
Just find the macros tab on the sheet and click record new macro , then select any one of the row and do what you wanted to do , say deleting the entire row, just delete the entire row and now go back to macros tab and click stop recording .
Now click alt+F11 , this would take you to the VBA editor there you find some worksheets and modules in the vba project explorer field , if you dont find it search it using the view tab of the VBA editor, Now click on module1 and see the recorded macro , you will find something like these
selection.entirerow.delete
I hope i helped you a bit , and if you need any more help please let me know, Thanks
Fastest method:
Sub DeleteUsingAutoFilter()
Application.ScreenUpdating = False
With ActiveSheet
.AutoFilterMode = False
.Columns("A").AutoFilter Field:=1, Criteria1:="ERR"
.AutoFilter.Range.Offset(1, 0).EntireRow.Delete
.AutoFilterMode = False
End With
Application.ScreenUpdating = True
End Sub
Second fastest method (lots of variations to this one too):
Sub DeleteWithFind()
Dim rFound As Range, rDelete As Range
Dim sAddress As String
Application.ScreenUpdating = False
With Columns("A")
Set rFound = .Find(What:="ERR", After:=.Resize(1, 1), SearchOrder:=xlByRows)
If Not rFound Is Nothing Then
Set rDelete = rFound
Do
Set rDelete = Union(rDelete, rFound)
Set rFound = .FindNext(rFound)
Loop While rFound.Row > rDelete.Row
End If
If Not rDelete Is Nothing Then rDelete.EntireRow.Delete
End With
Application.ScreenUpdating = True
End Sub
Autofilter method for multiple sheets:
Sub DeleteUsingAutoFilter()
Dim vSheets As Variant
Dim wsLoop As Worksheet
Application.ScreenUpdating = False
'// Define worksheet names here
vSheets = Array("Sheet1", "Sheet2")
For Each wsLoop In Sheets(vSheets)
With wsLoop
.AutoFilterMode = False
.Columns("A").AutoFilter Field:=1, Criteria1:="ERR"
.AutoFilter.Range.Offset(1, 0).EntireRow.Delete
.AutoFilterMode = False
End With
Next wsLoop
Application.ScreenUpdating = True
End Sub
Assuming there are always values in the cells in column A and that the data is in the first sheet, then something like this should do what you want:
Sub deleteErrRows()
Dim rowIdx As Integer
rowIdx = 1
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets(1)
While ws.Cells(rowIdx, 1).Value <> ""
If ws.Cells(rowIdx, 1).Value = "ERR" Then
ws.Cells(rowIdx, 1).EntireRow.Delete
Else
rowIdx = rowIdx + 1
End If
Wend
End Sub