I'm a beginner in VBA so I'm probably making very elementary mistakes.
I want to delete all rows in each of the worksheets of a workbook where the row has no entry in column S.
I have written the following bit of code using some insights from previously answered questions, but it is not working as expected:
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
For Each cell In Range("s1:s400")
If IsEmpty(cell) Then
cell.EntireRow.Delete shift:=xlUp
End If
Next
Next
The first loop is not being followed at all. Only the active sheet has any rows deleted.
The second loop is applied inconsistently, as not all rows with empty cells in the S column are being deleted.
Thank you for any help you can provide.
Two things.
First you need to assign the sheet to the range object so Range("s1:s400") should be ws.Range("s1:s400")
Second when deleting rows in a loop, loop backwards. This cannot be done in a For Each loop so change to a regular for loop and Step -1
Dim ws As Worksheet
Dim i As Long
For Each ws In ThisWorkbook.Worksheets
For i = 400 To 1 Step -1
If ws.Cells(i, "S").Value = "" Then
ws.Rows(i).Delete
End If
Next
Next
For more and faster methods on deleting rows see HERE.
Related
I am trying to cut and past values from a range of cells on sheet 1 to the next available row on sheet 2. All guides and advice I've seen has been for copying and pasting and for same sheet.
Range on sheet 1 is E5-H5 to be cut, not copied, and then pasted to sheet 2, cells E7-H7 or the next available row below that as each time someone enters data I need sheet 2 to keep it.
Don't select. I post this answer more to help #KoderM16 improve their methods than to answer the original question:
Sub CutPaste()
ThisWorkbook.Sheets("Sheet1").Range("E5:H5").Copy
Sheets("Sheet2").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).PasteSpecial
End Sub
Also this doesn't make sense as it returns true or false (will most likely always be true because it can in fact select that address):
Lastrow = Sheets("Sheet2").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Select
You would want .row on the end instead of .select if you want to assign the row to Lastrow, you don't however then use lastrow.
With your code as it is, lastrow would most likely always be -1 as that is the value for True
The below code will copy your range and look for the 1st empty cell (from the bottom up) in column E, Sheet 2, to paste. Hope this helps.
Sub CutPaste()
Dim Lastrow As Long
ThisWorkbook.Sheets("Sheet1").Range("E5:H5").Copy
Lastrow = Sheets("Sheet2").Cells(Rows.Count, 5).End(xlUp).Offset(1, 0).Select
Selection.PasteSpecial
End Sub
As you are new to Stack Overflow and probably vba as well, just try to adhere to the comment above by Peh. Your question, while not specifically, is easily googlable in parts. Also, if this answers your question, please tick it.
Use case: I want to copy data from column A to Column B (where column A, B are arbitrary columns). Once the data is in Column B, I want to remove duplicate entries within column B.
Make a loop that moves data from column A to column B and then removes duplicates for each sheet in a workbook.
`Sub Copy()
For i = 1 To Sheets.Count
Worksheets(i).Range("A1:A100")
Destination:=Worksheets(i).Range("B1")
Next
End Sub
`
For testing I separated the tasks into two different Sub(). Sub Copy() is working and correctly copies my data. Sheet1 is also named "Sheet1" for my specific workbook
`Sub RemoveStuff()
Dim rng As Range
For j = 1 To Sheets.Count
Set rng = Worksheets("Sheet1").Range(Range("B1"),Range("B1").End(xlDown)).Select
rng.RemoveDuplicates Columns:=(1), Header:=xlGuess
Next
End Sub
`
My error seems to be in defining the range correctly. Each sheet will have a different number of entries to remove duplicates from. Sheet1 might have 50 rows and reduce to 6. Sheet2 could have 70 and reduce to 3. Sheet3 could have 20 rows and reduce to 12 uniques. Excel does not let you remove duplicates from range (B:B!)
How can I properly define my range so I can remove duplicates in a loop for a dynamically defined range for each sheet(sheet=tabs in workbook)?
EDIT 2-23-17
New code from Y0wE3K
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Columns("P:P").RemoveDuplicates,Columns:=1, Header:=xlYes
Next
End Sub
Still does not work. If I manually select Column P before I run the macro, it works. But it only goes for the one sheet I have selected, it does not seem to execute the loop. Definitely does not automatically do each sheet, or prompt me for each one.
EDIT: 3/4
Make sure that you do not have any protected data, I also experienced issues with pivot tables but I think this may be permissions thank you for help.
Your RemoveStuff subroutine can be rewritten as:
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets ' Use Worksheets instead of Sheets,
' in case there are any Charts
'You can just select the whole column, rather than selecting
'specific rows
ws.Columns("B:B").RemoveDuplicates Columns:=1, Header:=xlGuess
Next
End Sub
Sub RemoveStuff()
Dim ws As Worksheet
For Each ws In Worksheets
ws.Columns("P:P").RemoveDuplicates,Columns:=1, Header:=xlYes
Next
End Sub
This code will work. As a final note, please make sure you have no Protected Data, or pivot tables inside of the sheets you need to run the remove script on. For whatever reason that caused mine to fail, but running my script on the correct sheets that are unprotected worked GREAT.
My problem is the macro won't work on a specified worksheet, only the active one. I have two subroutines for deleting entire columns, and then deleting entire rows if specific columns are blank. I want to make it work for a specific worksheet, which I understood to be With Worksheets("OutPut") but it still culls the active worksheet.
It works as intended so long as the active worksheet is selected.
Sub DeleteBlankColumns()
With Worksheets("OutPut")
Set MyRange = Worksheets("OutPut").UsedRange
For iCounter = MyRange.Columns.Count To 1 Step -1
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
End If
Next iCounter
End With
End Sub
And
Sub QuickCull()
With Worksheets("OutPut")
On Error Resume Next
Columns("B").SpecialCells(xlBlanks).EntireRow.Delete
On Error Resume Next
Columns("C").SpecialCells(xlBlanks).EntireRow.Delete
On Error Resume Next
Columns("D").SpecialCells(xlBlanks).EntireRow.Delete
On Error Resume Next
Columns("E").SpecialCells(xlBlanks).EntireRow.Delete
End With
End Sub
There's a button to Call both of them, which again, will work if the worksheet I want to transform is active. For reference, this is intended to be appended on an existing company macro, so simply running it on the worksheet when it's active won't work.
Thank you!
For the first code sample,
If Application.CountA(Columns(iCounter).EntireColumn) = 0 Then
Columns(iCounter).Delete
should be
If Application.CountA(.Columns(iCounter).EntireColumn) = 0 Then
.Columns(iCounter).Delete
(a "." before Columns, to specify the sheet)
Same thing for the second code sample
I'm stuck on how to structure a piece of code that:
Loops through all worksheets that begin with the number 673: (e.g. 673:green, 673:blue)
Selects the data in these worksheets from row 5 up until the last row with data - code that works for this (generously provided by another user) is
Dim report As Worksheet
Set report = Excel.ActiveSheet
With report
.Range(.Cells(5, "K"), .Cells(.Rows.Count, "K").End(xlUp)).EntireRow.Select
End With
Select the "Colours" worksheet
Paste the rows at the next available blank row. There could be up to 40/50 worksheets which will have data pasted into the "Colours" worksheet so I need the data added to the next available line.
Thank you in advance.
Loop over the sheets in the workbook and check their names
For Each sheet in ActiveWorkbook.Worksheets
If Instr(sheet.Name,"673")>0 Then
...
End If
Next
Good, but you're going to want to copy.
Selection.Copy
Just select.
Worksheets("Colours").Select
Find the last row then go to the next. The row is found by finding the first populated row from the bottom up. Note I used explicit sheet references, which is unnecessary since you selected the sheet already. This is better form, however, if you will be manipulating data on multiple sheets in your code.
lastRow = Worksheets("Colours").Cells(Worksheets("Colours").rows.count,1).End(xlUp).Row
Worksheets("Colours").Cells(lastRow + 1, 1).Select
Activesheet.Paste
I have a workbook with ~20 sheets. In each sheet Column A has dates and Column B has data points. Column A is not the same in every sheet! I want to cut out data I don't need based on date ranges. I've tried this, and it runs for quite a long time, but does nothing.
Sub DeleteRowBasedOnDateRange()
Dim RowToTest As Long
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
For RowToTest = ws.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
With ws.Cells(RowToTest, 1)
If .Value > #6/16/2015# _
And .Value < #6/22/2015# _
Then _
ws.Rows(RowToTest).EntireRow.Delete
End With
Next RowToTest
Next
End Sub
Suggestions?
Sub DeleteRowBasedOnDateRange()
Dim RowToTest As Long
Dim ws As Worksheet
For Each ws In ThisWorkbook.Sheets
For RowToTest = ws.Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
With ws.Cells(RowToTest, 1)
If .Value < #6/16/2015# _
Or .Value > #6/22/2015# _
Then _
ws.Rows(RowToTest).EntireRow.Delete
End With
Next RowToTest
Next
End Sub
This code worked fine for me. You say the date of each sheet is in a different format. Maybe you need to try to fix the format before running the macro as it might not be looked at as a date. – bbishopca
bbshopca you were right! It does work. It turns out I had my logic all backwards. I wanted to delete dates OUTSIDE the range of 2015-06-16 to 2015-06-22, not within. Since I have so many rows of data, I would see that the dates before 2015-06-16 weren't being deleted and thought my code wasn't working. Thanks for the input all.
To speed it up, rather than delete one row at a time, you could sort the column by date, then find the rows within that range by using cells.find. Save those rows, then delete the range of rows at once. By doing it this way it's less brute force and it only requires finding 2 cells, and deleting rows once.