Deleting rows and detecting range for format

[Connie]

I have created a spreadsheet for payroll clerks to enter daily time
in/time out information for hundreds of employees. There is a sheet in
the spreadsheet for the clerks to enter the information. Another sheet
then calculates the hours worked from that data and prints it out. The
spreadsheet also has another sheet which contains the data for all
employees entered by the clerk. I have a command button which appends
the data for each employee to the sheet and then clears the input cells
so the clerk can enter another employee.

For the sheet with the combined employee data, I'm trying to delete all
rows that are either blank or equal zero. Data is potentially in
columns A through O, but the number of rows vary based on the number of
employees entered by the clerk. I am using the following code to
detect the first blank row, so that I can format the range and then
print it.

2 questions:
Is there a better way to do this other than what I've done which is
loop through 40000 rows?
What logic should I add to check for either nonblank or zero rows so I
can delete them? I've spent a few hours trying to get this to work and
am frustrated!!

Private Sub Print_Compiled_Totals_Click()

Sheets("Compiled Totals").Select
Maxrow = 1
maxcol = 1
For Each C In Sheets("Compiled Totals").Range("A1:O40000")
If C.Value <> "" And C.Column > maxcol Then maxcol = C.Column
If C.Value <> "" And C.Row > Maxrow Then Maxrow = C.Row
Next C
ActiveSheet.PageSetup.PrintArea = ("$A$1:" + Sheets("Compiled
Totals").Cells(Maxrow, maxcol).Address)
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
MsgBox "Printing Complete"

Thanks.
Connie

 

[Tom Ogilvy]

Put this function in a General/Standard module (in the VBE, Insert=>Module)

Function GetRealLastCell(sh as Worksheet) as Range
Dim RealLastRow As Long
Dim RealLastColumn As Long

On Error Resume Next
RealLastRow = _
sh.Cells.Find("*", sh.Range("A1"), , , xlByRows, xlPrevious).Row
RealLastColumn = _
sh.Cells.Find("*", sh.Range("A1"), , , xlByColumns, xlPrevious).Column
set GetRealLastCell = sh.Cells(RealLastRow, RealLastColumn)
End Function

-------------------------------------------
Modify your original code:

Private Sub Print_Compiled_Totals_Click()
Dim rng as Range
Sheets("Compiled Totals").Select
Maxrow = 1
maxcol = 1
set rng = GetRealLastCell(Activesheet)
ActiveSheet.PageSetup.PrintArea = ("$A$1:" + rng.Address)
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
MsgBox "Printing Complete"
End Sub

 

[Connie]

Thanks, Tom. I put the code in, but when I run it, the Sub
Print_Compiled_Totals stops after the ActiveSheet.PageSetup.PrintArea =
("$A$1:" + rng.Address) assignment. I determined that the function is
working and the reallastcolumn and reallastrow are correct, and that
the correct print range was assigned. But for some reason, I can't get
a printout. Any suggestions? Thanks.

 

[Tom Ogilvy]

ActiveSheet.PageSetup.PrintArea = "$A$1:" & rng.Address

would be the way I do it, but I didn't change anything substantial from the
way you were originally doing it.

 

[Connie]

I got it to work; I needed to reboot. I've been doing so much coding
today that I'm not surprised. Thanks again.

Any suggestions on how to delete the nonblank or nonzero rows in the
range?

Thanks again.

 

[Tom Ogilvy]

Without knowing anything about your sheet:

set rng = GetRealLastCell(Activesheet)
for i = rng.row to 1 step -1
if Application.CountA(rows(i)) = 0 then
rows(i).Delete
elseif Application.Sum(rows(i)) = 0 then
rows(i).Delete
end if
Next


obviously test it on a copy of your data.

 

[Connie]

I incorporated your code into mine and following is the code (sorry for
not posting earlier):


Private Sub CreateUploadFile_Click()
Dim FName As String
Dim wb As Workbook
Sheets("Upload Data").Select
Set rng = GetRealLastCell(ActiveSheet)
'delete blank rows
For i = rng.Row To 1 Step -1
If Application.CountA(Rows(i)) = 0 Then
Rows(i).Delete
ElseIf Application.Sum(Rows(i)) = 0 Then
Rows(i).Delete
End If
Next
' Create CSV file
Sheets("Field Rep Time Sheet").Select
FName = "Upload" & Format(Now(), "yyyymmmddhhmm")
Sheets("Upload Data").Copy
Set wb = ActiveWorkbook
wb.SaveAs FName & ".csv", FileFormat:=xlCSV
wb.Close SaveChanges:=False
MsgBox "Save as CSV with time and date stamp Complete"
End Sub

The sheet "Field Rep Time Sheet" is the sheet from which the command
button is called. I'm using the Sheets("Upload Data").Select to select
the sheet that contains the data for which I want to delete either 0 or
blank rows. However, for some reason when I run the code I go back to
the "Field Rep Time Sheet" sheet and the logic is executed there. What
am I missing? Thanks again.

 

[Guest]

for code in a sheet module, unqualified range references refer to the sheet
containing the code, not the activesheet.

Private Sub CreateUploadFile_Click()
Dim FName As String
Dim wb As Workbook
Dim sh as Worksheet
set sh = WorkSheets("Upload Data")
Set rng = GetRealLastCell(sh)
'delete blank rows
For i = rng.Row To 1 Step -1
If Application.CountA(sh.Rows(i)) = 0 Then
sh.Rows(i).Delete
ElseIf Application.Sum(sh.Rows(i)) = 0 Then
sh.Rows(i).Delete
End If
Next
' Create CSV file
Sheets("Field Rep Time Sheet").Select
FName = "Upload" & Format(Now(), "yyyymmmddhhmm")
Sheets("Upload Data").Copy
Set wb = ActiveWorkbook
wb.SaveAs FName & ".csv", FileFormat:=xlCSV
wb.Close SaveChanges:=False
MsgBox "Save as CSV with time and date stamp Complete"
End Sub

 

[Connie]

This worked. Now I hope I can apply the delete functionality to my
vblookup code! Thanks again.