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.
Related
I have a sheet List. I want the contents of list to be transferred to my sheet Evaluation. But my evaluation sheet, already consist of the previous evaluation. I want the new rows just below the old ones. Can some one help how I can achieve this ?
I have the below code with me, which is a copy paste functionality.
Sub lastweekctt()
Worksheets("List").Range("A4:W1000").Copy _
Destination:=Worksheets("Evaluation").Range("A5")
End Sub
I have my header in row 4 in both the sheets.
You need to get last blank row:
Sub lastweekctt()
Dim LastRow As Long
'get last row
LastRow = Worksheets("Evaluation").Cells(Rows.Count,1).End(xlUp).Row
Worksheets("List").Range("A4:W1000").Copy _
Destination:=Worksheets("Evaluation").Range("A" & LastRow + 1)
End Sub
Hope this help.
You will need to find the last row first
lLastRow = Worksheets("Evaluation").Cells(Worksheets("Evaluation").Rows.Count, 1).End(xlUp).Row
and then your destination range will look like this
.Range("A" & lLastRow + 1)
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.
I am looking for code for two different types of selection. One code would select in an L shape all of the rows in one column and all of the columns in one row. In the example of having data in the range A1:A10, and data in row 10 only from col A - K. The selection would look like an L. How can you do this without knowing how many rows or columns have data in them?
The second code would have the same data, but need to select the whole range A1:K10 in that example, but the code would need to select whatever range had the data.
i found the answer. i have to do a union. here is the code with the union at the end.
Sub mywork()
Dim ws As Worksheet
Dim lRow As Long, lCol As Long
Dim rng As Range
'~~> Set this to the relevant worksheet
Set ws = [Sheet1]
With ws
'~~> Get the last row and last column
lRow = .Range("A" & .Rows.Count).End(xlUp).Row
lCol = .Cells(lRow, .Columns.Count).End(xlToLeft).Column
'~~> Set the range
Set rng = .Range(.Cells(lRow, 1), .Cells(lRow, lCol))
End With
Set rng = Application.Union(Range("A1:A" & lRow), rng)
rng.Select
End Sub
activesheet.usedrange.address should tell you the used range.
In your case something like this should work: [sheet1].usedrange.select (Replaces all the code in the module)
The benefit here is the fact that you are not hard coding "A1:A" against the last identified cell, works well if you have blank rows at the top.
I am trying to come up with a lean and error-proofed macro to delete rows containing duplicate values in a column A. I have two solutions and both have their advantages. None of them are exactly what I want.
I need rows containing duplicates deleted but leaving the last row that contained the duplicate.
This one is awesome. It has no loop and works instantaneously. The problem is that it deletes subsequent rows containing duplicates hence leaving the first occurrence of the duplicate (And I need the last/ or second - most show up only twice)
Sub Delete()
ActiveSheet.Range("A:E").RemoveDuplicates Columns:=1, Header:=xlNo
End Sub
This one goes from the bottom and deletes duplicates. It lasts longer than the first one ( I have around 6k rows) But the issue with this one is that it doesnt delete them all. Some duplicates are left and they are deleted after I run the same code again. Even smaller number of duppes is still left. Basically need to run it up to 5 times and then I end up with clean list.
`
Sub DeleteDup()
Dim LastRowcheck As Long, n1 As Long, rowschecktodelete As Long
LastRowcheck = Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
For n1 = 1 To LastRowcheck
With Worksheets("Sheet1").Cells(n1, 1)
If Cells(n1, 1) = Cells(n1 + 1, 1) Then
Worksheets("Sheet1").Cells(n1, 1).Select
Selection.EntireRow.Delete
End If
End With
Next n1
End Sub
`
Is there a way to improve any of these to work well or is there a better solution? Any info is greatly appreciated. Thanks
The easiest way would be to delete all rows at once. Also to increase speed, you better do your checks with variables and not with the real cell values like this:
Sub DeleteDup()
Dim LastRowcheck As Long
Dim i As Long
Dim rows_to_delete As Range
Dim range_to_check As Variant
With Worksheets("Sheet1")
LastRowcheck = .Cells(Rows.Count, 1).End(xlUp).Row
range_to_check = .Range("A1:A" & LastRowcheck).Values
For i = 1 To LastRowcheck - 1
If range_to_check(i, 1) = range_to_check(i + 1, 1) Then
If rows_to_delete Is Nothing Then
Set rows_to_delete = .Cells(i, 1)
Else
Set rows_to_delete = Union(.Cells(i, 1), rows_to_delete)
End If
End If
Next n1
End With
rows_to_delete.EntireRow.Delete
End Sub
The concept is right, but remember that when you delete rows, Cells(n1 + 1, 1) isn't going to be the same thing as it was before you deleted a row. The solution is to simply reverse the loop and test rows from bottom to top:
Sub DeleteDup()
Dim last As Long
Dim current As Long
Dim sheet As Worksheet
Set sheet = Worksheets("Sheet1")
With sheet
last = .Range("A" & .Rows.Count).End(xlUp).Row
For current = last To 1 Step -1
If .Cells(current + 1, 1).Value = .Cells(current, 1).Value Then
.Rows(current).Delete
End If
Next current
End With
End Sub
Note that you can use the loop counter to index .Rows instead of using the Selection object to improve performance fairly significantly. Also, if you grab a reference to the Worksheet and toss the whole thing in a With block you don't have to continually dereference Worksheets("Sheet1"), which will also improve performance.
If it still runs too slow, the next step would be to flag rows for deletion, sort on the flag, delete the entire flagged range in one operation, then sort back to the original order. I'm guessing the code above should be fast enough for ~6K rows though.
I have already created a VBA script that is about 160 lines long, which produces the report that you see below.
Without using cell references (because the date ranges will change each time I run this) I now need to take the users ID, name, total hours, total break, overtime 1, and overtime 2 and copy this data into sheet 2.
Any suggestions as to how I can structure a VBA script to search row B until a blank is found, when a blank is found, copy the values from column J, K, L, M on that row, and on the row above copy value C - now paste these values on sheet 2. - Continue this process until you find two consecutive blanks or the end of the data...
Even if you can suggest a different way to tackle this problem than the logic I have assumed above it would be greatly appreciated. I can share the whole code if you are interested and show you the data I began with.
Thank you in advance,
J
As discussed, here's my approach. All the details are in the code's comments so make sure you read them.
Sub GetUserNameTotals()
Dim ShTarget As Worksheet: Set ShTarget = ThisWorkbook.Sheets("Sheet1")
Dim ShPaste As Worksheet: Set ShPaste = ThisWorkbook.Sheets("Sheet2")
Dim RngTarget As Range: Set RngTarget = ShTarget.UsedRange
Dim RngTargetVisible As Range, CellRef As Range, ColRef As Range, RngNames As Range
Dim ColIDIndex As Long: ColIDIndex = Application.Match("ID", RngTarget.Rows(1), 0)
Dim LRow As Long: LRow = RngTarget.SpecialCells(xlCellTypeLastCell).Row
'Turn off AutoFilter to avoid errors.
ShTarget.AutoFilterMode = False
'Logic: Apply filter on the UserName column, selecting blanks. We then get two essential ranges.
'RngTargetVisible is the visible range of stats. ColRef is the visible first column of stats.
With RngTarget
.AutoFilter Field:=ColIDIndex, Criteria1:="=", Operator:=xlFilterValues, VisibleDropDown:=True
Set RngTargetVisible = .Range("J2:M" & LRow).SpecialCells(xlCellTypeVisible)
Set ColRef = .Range("J2:J" & LRow).SpecialCells(xlCellTypeVisible)
End With
'Logic: For each cell in the first column of stats, let's get its offset one cell above
'and 7 cells to the left. This method is not necessary. Simply assigning ColRef to Column C's
'visible cells and changing below to CellRef.Offset(-1,0) is alright. I chose this way so it's
'easier to visualize the approach. RngNames is a consolidation of the cells with ranges, which we'll
'copy first before the stats.
For Each CellRef In ColRef
If RngNames Is Nothing Then
Set RngNames = CellRef.Offset(-1, -7)
Else
Set RngNames = Union(RngNames, CellRef.Offset(-1, -7))
End If
Next CellRef
'Copy the names first, then RngTargetVisible, which are the total stats. Copying headers is up
'to you. Of course, modify as necessary.
RngNames.Copy ShPaste.Range("A1")
RngTargetVisible.Copy ShPaste.Range("B1")
End Sub
Screenshots:
Set-up:
Result:
Demo video here:
Using Filters and Visible Cells
Let us know if this helps.