I have the following code which looks down column M to find empty cells. Each time an empty cell is found, then the entire row is deleted.
The code always leaves one row undeleted.
Can someone help to identify what is wrong with the code? I suspect that in deleting a row, the cell count goes wrong.
Private Sub CreateInvoice_Click()
Dim LastRow As Long
Dim cl As Range, rng As Range
With Sheet4
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set rng = Sheet4.Range("M1:M" & LastRow)
For Each cl In rng
If IsEmpty(cl) Then
cl.EntireRow.Select ' MsgBox .Range("A" & cl.Row).Value & " has nothing in it"
End If
Next
End With
End Sub
I would use a filter as it's the fastest and most efficient way of deleting empty rows. Also the below doesn't use .Select method.
Sub RemoveEmpties()
Dim ws As Worksheet
Dim rng As Range
Dim lastRow As Long
Set ws = Sheet4
lastRow = ws.Range("M" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("M1:M" & lastRow)
With rng
.AutoFilter Field:=1, Criteria1:=""
.Offset(1, 0).SpecialCells(xlCellTypeVisible).EntireRow.Delete
End With
ws.AutoFilterMode = False
End Sub
Columns("M:M").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
Try using this
Related
I am trying to filter & select all columns (A to R) which contain the value "New" in column R. I then want to copy this selection and paste as value it to the bottom of the table on worksheet "Worklist".
I don't understand why the code is using an "If" function to look at the subtotal and think I did the copy & pasting part wrong, since I'm getting an error.
Sub CopyPartOfFilteredRange()
Dim lastRow As Long
With ThisWorkbook.Sheets("ProcessingSheet")
.AutoFilterMode = False
lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:R" & lastRow)
.AutoFilter Field:=18, Criteria1:="New"
If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then 'count visible cells in column "A" other than the header
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy Destinations:=Sheets("Worklist").Cells(.Range("B" & .Rows.Count).End(xlUp).Row + 1, 1)
End If
End With
End With
End Sub
Copy Filtered Data feat. Subtotal
Range.Subtotal method
SpeacialCells will raise an error if no matching values are found by the AutoFilter. Subtotal is used to avoid this by returning the number of found values.
The Code
Option Explicit
Sub CopyPartOfFilteredRange()
With ThisWorkbook.Sheets("ProcessingSheet")
.AutoFilterMode = False
Dim lastRow As Long: lastRow = .Range("A" & .Rows.Count).End(xlUp).Row
With .Range("A1:R" & lastRow)
.AutoFilter Field:=18, Criteria1:="New"
If WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then
Dim dws As Worksheet
Set dws = ThisWorkbook.Worksheets("Worklist")
.Offset(1).Resize(.Rows.Count - 1) _
.SpecialCells(xlCellTypeVisible).Copy _
Destination:=dws.Cells(dws.Range("B" & dws.Rows.Count) _
.End(xlUp).Row + 1, 1)
End If
End With
.AutoFilterMode = False
End With
End Sub
Please try the following code and let me know how you go. It works (tested) based on your description of the data.
Option Explicit
Sub CopyPartOfFilteredRange()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim LRow As Long, PasteRow As Long
Dim rng As Range
Set ws1 = ThisWorkbook.Worksheets("ProcessingSheet")
Set ws2 = ThisWorkbook.Worksheets("Worklist")
LRow = ws1.Cells(Rows.Count, 18).End(xlUp).Row
PasteRow = ws2.Cells(Rows.Count, 2).End(xlUp).Row + 1
Set rng = ws1.Range("A1:R" & LRow)
With rng
.AutoFilter 18, "New"
.Offset(1).Copy ws2.Cells(PasteRow, 2)
.AutoFilter
End With
End Sub
I have to generate a spreadsheet of upcoming events, and I use a macro that creates a thick line that separates each date from the one above it. It's based on the value change in the "Date" column". However, sometimes I have to filter the data by another criteria (say, the county). In those cases, the offset macro I've been using doesn't always work, as the data that changes and produces the line is in a hidden row, and therefore the line is as well. Can anyone help?
I've tried various ways of defining the range as active cells only, but I don't think I'm doing it correctly.
The macro I'm using is as follows, without applying to hidden rows:
Sub UpcomingLines()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
For Each rng In Range("A1:A100" & LastRow)
If rng <> rng.Offset(1, 0) Then
Range("A" & rng.Row & ":H" & rng.Row).Borders(xlEdgeBottom).Weight = xlThick
End If
Next rng
Application.ScreenUpdating = True
End Sub
I've tried integrating SpecialCells like this:
Sub UpcomingLines()
Application.ScreenUpdating = False
Dim LastRow As Long
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Dim rng As Range
Set myrange = Range("A1:H" & Cells(Rows.Count, "A").End(xlUp).Row).SpecialCells(xlCellTypeVisible)
For Each rng In Range("A1:A100" & LastRow)
If rng <> rng.Offset(1, 0) Then
Range("A" & myrange.Row & ":H" & rng.Row).Borders(xlEdgeBottom).Weight = xlThick
End If
Next rng
Application.ScreenUpdating = True
End Sub
However, this generates lines in places I don't want them -- basically, the show up between date changes, but also everyplace there is a hidden row, even if there is no date change before or after the hidden row.
Try something like this:
Sub UpcomingLines()
Dim ws As Worksheet, LastRow As Long, c As Range, theDate
Application.ScreenUpdating = False
Set ws = ActiveSheet
ws.Range("A1").CurrentRegion.Borders.LineStyle = xlNone 'remove existing borders
LastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
theDate = 0
For Each c In ws.Range("A2:A" & LastRow).SpecialCells(xlCellTypeVisible)
'different date from previous visible row?
If c.Value <> theDate Then
'add border to top of row if not the first change
If theDate <> 0 Then c.Resize(1, 8).Borders(xlEdgeTop).Weight = xlThick
theDate = c.Value 'remember this date
End If
Next c
Application.ScreenUpdating = True
End Sub
I need a macro that need to filter a column and to take out the required date value along with the cell position (i.e say "4/22/2018" cell position "A9 or just 9"). Kindly help me out to fix this issue
See the code that I wrote below
Dim Date As String
Date = Sheets("alldata")
Rows("3:3").Select.AutoFilter.Range("$A$3:$AA$606").AutoFilter , Field:=1, Criterial:="#VALUE!"
Range("A3").Select.xlFilterValues.offset(1, 0).Copy.value
Sheets("Log").Cells(2, "AF").value = Date
Is this what you are trying?
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Set ws = Sheets("alldata")
With ws
Set rng = .Range("$A$3:$A$606")
'~~> Remove any filters
.AutoFilterMode = False
With rng
.AutoFilter Field:=1, Criteria1:="<>#VALUE!"
'~~> Get the Row Number
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Row
'~~> Get The cell Address
MsgBox .Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Address
'~~> Get the Date
Sheets("Log").Cells(2, "AF").Value = _
.Offset(1, 0).SpecialCells(xlCellTypeVisible).Cells(1, 1).Value
End With
'~~> Remove any filters
.AutoFilterMode = False
End With
End Sub
The following will filter the dates and for each date it will copy the value into Sheet Log in Column AF:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("alldata")
Dim wsLog As Worksheet: Set wsLog = Sheets("Log")
'declare and set your worksheet, amend as required
Dim LastRow As Long, LogLastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'get the last row with data on Column A
Dim c As Range, rng As Range
ws.Rows("3:3").AutoFilter
ws.Range("$A$3:$AA$" & LastRow).AutoFilter Field:=1, Operator:=xlFilterValues, Criteria2:=Array(0, "01/01/2018")
Set rng = ws.Range("$A$4:$A$" & LastRow).SpecialCells(xlCellTypeVisible)
For Each c In rng
LogLastRow = wsLog.Cells(wsLog.Rows.Count, "AF").End(xlUp).Row
c.Copy Destination:=wsLog.Cells(LogLastRow, "AF")
'if instead of copying the value, you want to return its address,
'you can get the address by using "c.Address" for each value in the range
Next c
End Sub
I'm new to VBA and after much searching, i can't get the code working correctly. I am trying to filter/select anything which has the value 313 in column B AND the values 1 OR 2 in column C then copy all the relevant rows with the data from all columns (A-N) at the bottom of the same worksheet. The worksheet does not have a set number of rows and 313 is not always in the same set of cells. I have tried the following but the code seems to be pasting in 'A2' rather than the selection at the bottom. Any help would be much appreciated.
Sub CopyPartOfFilteredRange()
Dim ws1 As Worksheet
Dim filterRange As range
Dim copyRange As range
Dim lastRow As Long
Set ws1 = ThisWorkbook.Sheets("Sheet 1")
ws1.AutoFilterMode = False
lastRow = ws1.range("A" & ws1.Rows.Count).End(xlUp).Row
Set filterRange = ws1.range("A1:N" & lastRow)
Set copyRange = ws1.range("A2:N" & lastRow)
filterRange.AutoFilter Field:=2, Criteria1:="313"
filterRange.AutoFilter Field:=3, Criteria1:="=1", _
Operator:=xlAnd, Criteria2:="=2"
lastRow = ws1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
ws1.Cells(lastRow, 1).Select
ws1.Paste
ws1.AutoFilterMode = False
End Sub
you must:
change xlAnd into xlOr
increase lastRow of 1 to reference the cell to paste in
use SpecialCells(xlCellTypeVisible) to select filtered cells (if any!)
try his
Option Explicit
Sub CopyPartOfFilteredRange()
Dim lastRow As Long
With ThisWorkbook.Sheets("Sheet 1")
.AutoFilterMode = False
lastRow = .Range("A" & .Rows.Count).End(xlUp).row
With .Range("A1:N" & lastRow)
.AutoFilter Field:=2, Criteria1:="313"
.AutoFilter Field:=3, Criteria1:="1", Operator:=xlOr, Criteria2:="2"
If Application.WorksheetFunction.Subtotal(103, .Cells.Resize(, 1)) > 1 Then 'count visible cells in column "A" other than the header
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).Copy .Cells(lastRow + 1, 1)
End If
End With
.AutoFilterMode = False
End With
End Sub
I believe that because you are redefining the last row after a filter, using xlUp will miss the last row since it may be hidden in the filter. I would suggest using
lastRow = lastRow + 1
since you already have the last row of the range defined and you just want to past one row below that.
Your second filter, by the way, will filter on nothing because no cell will be both equal to 1 and equal to 2. Not sure what you want there. In any case, like I said in my comment, I don't believe you are copying anything, so you will need
filterRange.Copy
after the filter. I am not sure I would recommend copying and pasting like this, but I am going to try to just modify your code instead of rewriting it.
Also, I don't believe that
Set copyRange = ws1.range("A2:N" & lastRow)
is needed at all and can be deleted.
This is what I have in full
Sub CopyPartOfFilteredRange()
Dim ws1 As Worksheet
Dim filterRange As Range
Dim lastRow As Long
Set ws1 = Worksheets("Sheet1")
ws1.AutoFilterMode = False
lastRow = ws1.Range("A" & ws1.Rows.Count).End(xlUp).Row
Set filterRange = ws1.Range("A1:N" & lastRow)
filterRange.AutoFilter Field:=2, Criteria1:="313"
filterRange.Copy
lastRow = lastRow + 1
ws1.Cells(lastRow, 1).Select
ws1.Paste
ws1.AutoFilterMode = False
End Sub
Why does this copy data down to the next blank cell till the next full cell, then take that cell's data and start over again?
Option Explicit
Sub CopyDown()
Dim wsPOD As Worksheet
Dim lastrow
Set wsPOD = Sheets("PO Data")
With wsPOD
lastrow = wsPOD.Range("F" & Rows.Count).End(xlUp).Row
wsPOD.Range("A2:D" & lastrow).Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
End With
End Sub
I understand the majority of the script, but I don't understand this part:
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.FormulaR1C1 = "=R[-1]C"
The last part especially means gibberish to me, can someone help me understand this please?
Based on my comment you can tidy up the code using
Option Explicit
Sub CopyDown()
Dim wsPOD As Worksheet
Dim lastrow as long
Dim EmptyCells as range
Set wsPOD = Sheets("PO Data")
With wsPOD
lastrow = .Range("F" & .Rows.Count).End(xlUp).Row
set EmptyCells = .Range("A2:D" & lastrow).SpecialCells(xlCellTypeBlanks)
EmptyCells.FormulaR1C1 = "=R[-1]C"
End With
End Sub