I want to delete rows, if cells in a certain column are empty.
I'm using the sample code I found here.
Initially, the cells in question were in column B. I used the following:
Sub delrowEmptyStr()
Dim EmpCol As Range, LstRw As Long
LstRw = Columns(2).Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
Set EmpCol = Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Offset(, 1).EntireColumn
With Intersect(Rows("2:" & LstRw), EmpCol)
.FormulaR1C1 = "=IF(RC2="""",""X"","""")"
.Value = .Value
.SpecialCells(xlConstants).EntireRow.Delete
End With
End Sub
I reformatted and put that data in column A. I changed the Sub to the following:
Sub delrowEmptyStr()
Dim EmpCol As Range, LstRw As Long
LstRw = Columns(1).Find(What:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
Set EmpCol = Cells.Find(What:="*", SearchOrder:=xlColumns, SearchDirection:=xlPrevious, LookIn:=xlFormulas).Offset(, 1).EntireColumn
With Intersect(Rows("2:" & LstRw), EmpCol)
.FormulaR1C1 = "=IF(RC1="""",""X"","""")"
.Value = .Value
.SpecialCells(xlConstants).EntireRow.Delete
End With
End Sub
Running this now yields 'Run-time error 1004: No cells were found'.
Hitting 'Debug' highlights the row
.SpecialCells(xlConstants).EntireRow.Delete
I did sort my data differently before running the 2nd iteration of the Sub - I'm wondering if maybe having all the empty cells I want to get rid of to the bottom of the column may be the issue?
I'm wondering if maybe having all the empty cells I want to get rid of to the bottom of the column may be the issue?
Yes, definitely, because the statement
LstRw = Columns(1).Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
yields the LstRw as the last non-empty row in that specific column. You can fix this by simply finding the last non-empty row in your whole sheet instead of the last non-empty row in the specific column:
' vvvvvv
LstRw = Cells.Find(What:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlFormulas).Row
Related
I'm trying to make a Macro to clean Dataset by deleting blank cells using an Autofilter method with a header instead of a column number. As you can see. There is no Cells number in this Macro and there will not. Everything has to be automatic. That is the idea.
I wrote 90% of the code. I arrived at the water source but I can not drink.
I got the error for the last line.
Error 1004: AutoFilter method of Range class failed.
Here is the code:
Sub DeleteBlank()
Dim WrkS As Worksheet, LsC As Range, FsC As Range, Tab As Range
Dim LsH As Range, RNbr As Long, CNbr As Long, HdrRow As Range, FltCol As Variant
Set WrkS = Worksheets("data")
' Last cells
Set LsC = Cells(Cells.Find(what:="*", SearchOrder:=xlRows, _
SearchDirection:=xlPrevious, LookIn:=xlValues).row, _
Cells.Find(what:="*", SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, LookIn:=xlValues).Column)
' First cells
Set FsC = Cells(Cells.Find(what:="*", after:=LastCell, SearchOrder:=xlRows, _
SearchDirection:=xlNext, LookIn:=xlValues).row, _
Cells.Find(what:="*", after:=LastCell, SearchOrder:=xlByColumns, _
SearchDirection:=xlNext, LookIn:=xlValues).Column)
FsC.Activate
RNbr = ActiveCell.row
LsC.Activate
CNbr = ActiveCell.Column
'to set the last header
Set LsH = Cells(RNbr, CNbr)
' to set the header Row
Set HdrRow = Range(FsC, LsH)
Set Tab = WrkS.UsedRAnge
' to get the Column name in which I have to delete all blank
With HdrRow
FltCol = .Find(what:="name", LookAt:=xlWhole).Column
End With
' the problem is below
' Error 1004: AutoFilter method of Range class failed.
WrkS.Tab.AutoFilter Field:=FltCol, Criteria1:="="
End Sub
Can you try this? I couldn't declare a variable called "Tab". Since it was already defined as a range on WrKS you don't need the sheet reference on the AF line. Also, when using Find best to check the value is found to avoid errors. You should really use sheet references everywhere (or activate the sheet at the beginning).
Sub DeleteBlank()
Dim WrkS As Worksheet, LsC As Range, FsC As Range, Tab1 As Range
Dim LsH As Range, RNbr As Long, CNbr As Long, HdrRow As Range, FltCol As Variant
Set WrkS = Worksheets("data")
Set LsC = Cells.Find(what:="*", SearchOrder:=xlRows, SearchDirection:=xlPrevious, LookIn:=xlValues)
Set FsC = Cells.Find(what:="*", after:=LastCell, SearchOrder:=xlRows, SearchDirection:=xlNext, LookIn:=xlValues)
If Not FsC Is Nothing Then
If Not LsC Is Nothing Then
RNbr = FsC.Row
CNbr = LsC.Column
Set LsH = Cells(RNbr, CNbr)
Set HdrRow = Range(FsC, LsH)
Set Tab1 = WrkS.UsedRange
FltCol = HdrRow.Find(what:="name", LookAt:=xlWhole).Column
Tab1.AutoFilter Field:=FltCol, Criteria1:="="
End If
End If
End Sub
maybe you can shorten it down to this
Option Explicit
Sub DeleteBlank()
With Worksheets("data").UsedRange ' reference relevant worksheet "usedrange"
With Intersect(.Rows(1).Find(what:="name", LookAt:=xlWhole).EntireColumn, .Cells) 'reference its column whose top cell content is "name"
.AutoFilter Field:=1, Criteria1:="=" 'filter referenced column blank cells
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .Resize(.Rows.Count - 1).Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete ' if any filtered cells other than first row (header) then delete their entire row
End With
.Parent.AutoFilterMode = False
End With
End Sub
I am having an issue with a piece of VBA in excel and am looking for assistance.
I require a piece of code to auto populate a formula in excel through a series of data, the series will vary in length and will occupy columns C:I.
I have been using this piece of code without issue for quiet a while:
Sub Auto_Fill_Formula()
Sheets("Sheet1").Select
Dim LstRow As Long
With Sheets("Sheet1")
LastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
.Range("A2:A" & LastRow).Formula = "Formula added here"
Application.CutCopyMode = False
End With
End Sub
However as the formula is being added to the leftmost column it only populates the first cell, cell A2.
How can I modify this code to work when the leftmost column is empty?
Thank you,
Wayne
You can use Find to find the last used row in C:I by searching backwards from row 1. You should also use Option Explicit to pick up typos in variable names (LstRow).
Sub Auto_Fill_Formula()
Sheets("Sheet1").Select
Dim LastRow As Long, r As Range
With Sheets("Sheet1")
Set r = .Range("C:I").Find(What:="*", After:=.Range("C1"), Lookat:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False, SearchFormat:=False)
If Not r Is Nothing Then
LastRow = r.Row
.Range("A2:A" & LastRow).Formula = "Formula added here"
End If
End With
End Sub
This code works well in Excel 2003 but fails in Excel 2007. What am I not seeing in it that crashes it? It errors out when it gets to the "LastRow =".. This is my error message:
Run-Time Error 13 Type Mismatch
Dim LastRow As Long
Dim LastColumn As Integer
Dim LastCell As Range, NextCell As Range
' ****************************************************
' Finds LastRow and LastColumn
With Worksheets("DB")
' Find Last Row/Col
If WorksheetFunction.CountA(Cells) > 0 Then
' Search for any entry, by searching backwards by rows
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
' Search for any entry, by searching backwards by columns
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
Set NextCell = Worksheets("DB").Cells(LastRow + 1, (LastColumn))
End With
' ****************************************************
Found an error. Guess I copied the Lastrow and was GOING to change the second one to columns. but that still doesn't solve the hang on the first chunk. Opps while editing that last part to columns I see that I may have typed an extra "s" in the .Rows Looks like it SHOULD be .Row I'll see when I get home since my hard copy at work shows no "s". Guess that's what I get when trying to "Remember" the code when I get home. To "s" or not to "s", that is the question. LOL At least I think I solved it with a little poke the the head. Thanks Siddharth.
Are you sure it works with Excel 2003?
You have to use .Row instead of .Rows. See This
Your code will also fail because your LastColumn=0
Is this what you are trying?
Sub Sample()
Dim LastRow As Long
Dim LastColumn As Integer
Dim NextCell As Range
With Worksheets("DB")
If WorksheetFunction.CountA(Cells) > 0 Then
'~~> Find Last Row
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
'~~> Find Last Column
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
End If
'~~> Set the cell to the first empty cell after the last cell
'~~> which has data
Set NextCell = Worksheets("DB").Cells(LastRow + 1, (LastColumn))
'~~> Display the address of that cell
MsgBox NextCell.Address
End With
End Sub
I am new to VBA and am trying to write a macro that takes a workbook with several sheets of data and formats it for printing. Each sheet has tables of information (like operating/income statements). I want this code to be able to work for workbooks anyone creates but has the same basic information. This means I need to find start and end of the data on each sheet because it is not always in the same place (someone might start from "A1" and someone else from "B4", etc).
I've looked on the many websites for different ways to locate the first row used and last column used. What I have so far sometimes locates the starting row, ending row, starting column, and ending column correctly and other times it doesn't.
Sub FormatWorkbook()
Dim ws As Worksheet
Dim rowStart As Long
Dim columnStart As Long
Dim rowEnd As Long
Dim columnEnd As Long
Dim printStart As String
Dim printEnd As String
Application.ScreenUpdating = False
'Turn off print communication
Application.PrintCommunication = False
'Loop through sheets
For Each ws In Worksheets
'Make current sheet activesheet
ws.Select
'Set rowStart, columnStart, rowEnd, and columnEnd to the used range
With ActiveSheet
rowStart = .Cells.Find(what:="*", after:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, searchdirection:=xlNext, MatchCase:=False).Row
columnStart = .Cells.Find(what:="*", after:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlNext, MatchCase:=False).Column
rowEnd = .Cells.Find(what:="*", after:=.Range("A1"), LookAt:=xlPart, LookIn:=xlFormulas, searchorder:=xlByRows, searchdirection:=xlPrevious, MatchCase:=False).Row
columnEnd = .Cells.Find(what:="*", after:=.Range("A1"), LookAt:=xlPart, LookIn:=xlValues, searchorder:=xlByColumns, searchdirection:=xlPrevious, MatchCase:=False).Column
End With
This is just a portion of the program but the one I am most confused about. If anyone could help out I would really appreciate it. Also, if there is a better way to accomplish this task I'm all ears. The rest of my code is below for reference.
'Insert or Delete Space above the first used row
If rowStart < 4 Then
Do While rowStart < 4
Range("1:1").Select
Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
ws.Select
With ActiveSheet
rowStart = .Cells.Find(what:="*", after:=.Range("A1"), LookIn:=xlValues, searchorder:=xlByRows, searchdirection:=xlNext).Row
End With
Loop
ElseIf rowStart > 4 Then
Do While rowStart > 4
Range("1:1").Select
Selection.Delete Shift:=xlUp
ws.Select
With ActiveSheet
rowStart = .Cells.Find(what:="*", after:=.Range("A1"), LookIn:=xlValues, searchorder:=xlByRows, searchdirection:=xlNext).Row
End With
Loop
End If
'I think I need to adjust the columnStart, rowEnd, and columnEnd values after inserting and deleting rows
ws.Select
printStart = ActiveSheet.Cells(1, columnStart).Address
printEnd = ActiveSheet.Cells(rowEnd, columnEnd).Address
'Format headers, footers, and set the print area
ActiveSheet.PageSetup.CenterHeaderPicture.Filename = _
"\\antilles\MyDocs\xxxx\My Documents\My Pictures\xxxx.png"
With ActiveSheet.PageSetup
.CenterHeader = "&G"
.LeftFooter = "&""Palatino Linotype,Regular""&F"
.CenterFooter = "&""Palatino Linotype,Regular""Prepared By: xxxx"
.RightFooter = "&""Palatino Linotype,Regular""&D"
.PrintArea = printStart & ":" & printEnd
End With
Next ws
Application.PrintCommunication = True
End Sub
I've done a lot of this and I recommend simple crude methods. Without coding a whole thing, but rather hinting...
dim iRow as integer
For iRow = 1 to ...
cells(iRow,65000).end(xlup).select
if activecell.row = 1 then
activecell.entirecolumn.delete
exit For
endif
next iRow
As much as possible force some structure on the sheets. Then go see
http://www.ozgrid.com/VBA/ExcelRanges.htm
When googling, include
ozgrid|Pearson|Tushar|"Mr. Excel"|Erlandsen|Peltier|dailydoseofexcel
in the search string.
Excel VBA offers a selection of techniques for finding the first or last used row or column but none work in every situation.
Some problems with your code:
If the worksheet contains something, Find returns a range. A range has a row so your statements will work. But if the worksheet is empty, Find returns Nothing. You must use Set Rng = .Cells.Find ... then test Rng to not be Nothing before accessing Rng.Row or Rng.Column. See the code I reference below if this is not clear.
Note the after in After:=.Range("A1"). Find does not examine .Range("A1") until it has searched every other cell and wraps back to the beginning. In any example in which the start point is .Range("A1") the search direction will be xlPrevious so it immediately wraps and starts searching from the bottom right cell. Try After:=.Cells(Rows.Count, Columns.Count) when the search direction is xlNext.
There was an earlier question that was similar to yours. I posted some code which showed a selection of techniques for finding the last row or column and the situations in which they fail. I suggest you visit that answer and try the code: https://stackoverflow.com/a/18220846/973283.
Good luck and happy VBA programming.
How do I modify this line in VBA to only select the columns that have values?
Set rng = Range("A1", Range("A65536").End(xlUp)).SpecialCells(xlCellTypeVisible)
I don't think I'm doing something right since the CountLarge property is several billion cells
Here is a sample of my data
#SiddharthRout Yes I only need the rows that have data. I think I have it working now with End(xlToLeft) from #JMax ... Now that I'm iterating over the cells, I can just quit the For each loop once the last row is reached. I might have this working now. – makerofthings7 14 mins ago
For this neither you need .SpecialCells nor do you need to loop through the rows :)
Here is a sample code. This will copy all the rows which have data to Sheet2 (TRIED AND TESTED)
Sub Sample()
Dim ws As Worksheet
Dim rng As Range
Dim LastRow As Long, LastCol As Long
Set ws = Sheets("Sheet1")
With ws
LastRow = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
LastCol = .Cells.Find(What:="*", After:=.Range("A1"), Lookat:=xlPart, _
LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
MatchCase:=False).Column
With .Range("A1:" & Split(Cells(, LastCol).Address, "$")(1) & LastRow)
.AutoFilter Field:=1, Criteria1:="<>"
Set rng = ws.AutoFilter.Range
rng.Offset(1, 0).Resize(rng.Rows.Count - 1).Copy _
Destination:=Sheets("Sheet2").Range("A1")
End With
End With
End Sub
SNAPSHOT
I am assuming that all cells in a particular row will have data and there won't be a case like this
#makerofthings7: I think I know what exactly you are trying to do :) you don't need to use loops to achieve what you want. Just a quick question. Is it possible that say Cell C10 might have a value but B10 might not? – Siddharth Rout 12 mins ago
If there is then we will have to set the autofilter criteria accordingly.
Edit:
WAY 2
The other way would be to sort your data, pushing the blanks way down and then copying the resulting range :)
HTH