snyperj
asked on
Macro code help needed, please
I am using the code below tied to a command button at the top of the worksheet. The code autofits all columns and puts a total line at the bottom, 1 row after the last row of data. This worksheet receives data that is exported from access, so the amount of rows can vary. The column headers begin in row 4.
It works great as long as there is more than 1 row of data. If there is only 1 row of data (or no data rows) the user receives a "Run time error 1004, Application Defined or Object Defined Error" and line 27 is highlighted in code. How can I correct this please?
Another user on this site provided me with this great macro... I am hoping a small tweak will fix this problem.
Thanks!
It works great as long as there is more than 1 row of data. If there is only 1 row of data (or no data rows) the user receives a "Run time error 1004, Application Defined or Object Defined Error" and line 27 is highlighted in code. How can I correct this please?
Another user on this site provided me with this great macro... I am hoping a small tweak will fix this problem.
Thanks!
Sub DoTasks()
Dim cell As Range
Dim total As Long
Dim rows_in_col As Long
Dim header As Range
'Find cells in header
If Range("A4") = "" Then
'May only be one cell in header
Set header = Range("A4")
Else
Set header = Range(Range("A4"), Range("A4").End(xlToRight))
End If
'Find the max row
For Each cell In header
rows_in_col = Range(cell, cell.End(xlDown)).Count
If rows_in_col > total Then
total = rows_in_col
End If
Next cell
'Add the sum column two rows below max
For Each cell In header
If cell.Column = 11 Or cell.Column = 12 Then
Cells(cell.Row + total + 1, cell.Column).Formula = "=@subtotal(9," & Range(cell, cell.End(xlDown)).Address & ")"
End If
Next cell
'Same command as double clicking the border.
Range("A:M").EntireColumn.Autofit
Cells(header.Row + total + 1, 1).Activate
End Sub
I would fix the code by changing more things... but these changes below already do the job:
Sub DoTasks()
Dim cell As Range
Dim total As Long
Dim rows_in_col As Long
Dim header As Range
'Find cells in header
If Range("A4") = "" Then
'May only be one cell in header
Set header = Range("A4")
Else
Set header = Range(Range("A4"), Range("A4").End(xlToRight))
End If
If header Is Nothing Then Exit Sub
'Find the max row
For Each cell In header
rows_in_col = Range(cell, cell.End(xlDown)).Count
If rows_in_col > total And rows_in_col < Cells.Rows.Count - 5 Then
total = rows_in_col
End If
Next cell
If total > 1 Then
Range(Cells(header.Row + total + 1, 1), Cells(header.Row + total + 1, header.Columns.Count)).FormulaR1C1 = "=SUM(R5C:R[-2]C)"
End If
'Same command as double clicking the border.
Range("A:M").EntireColumn.AutoFit
Cells(header.Row + total + 1, 1).Activate
End Sub
I am also against determining last row using a loop and the .End method of the range object from the top.
this is why I had to fix the condition inside the loop.
this is why I had to fix the condition inside the loop.
ASKER
hmmm.. thanks for the efforts!
akoster - your change raises a new error, Runtime 424 Object Required and highlights the new line of code yo gave which I inserted instead of lines 17 - 22
Fernando- your change puts a total on every column. How can I get it back to just the columns that were being totaled? (11 & 12)
Thanks!
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Success! Thank you.
when no data is added, the total variable (the number of rows) will be the number of available rows in the worksheet (eg. 1048573)
When you add 1 to it (as in line 34), it won't fit any more.
A better way would be to use
Open in new window
instead of lines 17 up to 22.