S
SteveDB1
Hi Jim,
yesterday you'd provided a macro that compacts worksheets.
I have got it to work-- for most worksheets-- but there are a few that it
gets hung up on.
The problem that I had yesterday is that I was running it before I'd saved
the file to the new xlsx format, in 2007. Once I realized that it worked well
AFTER I saved to the xlsx format, it went well.
However, something has arisen that I do not understand, and cannot readily
identify. I've copied the code for the macro/UDF's below my discussion.
at the end of the 3rd function, I get an error at:
Set LastCell = wks.Cells(lngLastRow, intLastColumn)
WHEN I get the error, which so far has been infrequent, it happens there.
I see that the LastCell is a user defined function.
The error states that it's an "application defined, or object defined error."
I.e.,
LastCell = nothing
wks.cells(lngLastRow, intLastColumn) = <application defined, or object
defined error>
lngLastRow = 39
intLastColumn = 0
Would you please explain to me
1- why this would happen.
2- how to fix this from occurring in the future.
Thank you.
----------------------------------------------------------------------------
Sub CompactAllSheets()
Dim wks As Worksheet
'Dim lngVisible As Long
For Each wks In Worksheets
'lngVisible = wks.Visible
CompactSheet wks
'wks.Visible = lngVisible
Next wks
End Sub
Public Sub CompactSheet(Optional ByVal wks As Worksheet)
Dim rng As Range
If wks Is Nothing Then Set wks = ActiveSheet
Set rng = LastCell(wks)
wks.Range(rng.Offset(0, 1), wks.Cells(1,
Columns.Count)).EntireColumn.Delete
wks.Range(rng.Offset(1, 0), wks.Cells(Rows.Count, 1)).EntireRow.Delete
End Sub
Public Function LastCell(Optional ByVal wks As Worksheet) As Range
Dim lngLastRow As Long
Dim intLastColumn As Integer
If wks Is Nothing Then Set wks = ActiveSheet
On Error Resume Next
lngLastRow = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
intLastColumn = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
If lngLastRow = 0 Then
lngLastRow = 1
intLastColumn = 1
End If
Set LastCell = wks.Cells(lngLastRow, intLastColumn)
End Functio
--------------------------------------------------------------------------------
yesterday you'd provided a macro that compacts worksheets.
I have got it to work-- for most worksheets-- but there are a few that it
gets hung up on.
The problem that I had yesterday is that I was running it before I'd saved
the file to the new xlsx format, in 2007. Once I realized that it worked well
AFTER I saved to the xlsx format, it went well.
However, something has arisen that I do not understand, and cannot readily
identify. I've copied the code for the macro/UDF's below my discussion.
at the end of the 3rd function, I get an error at:
Set LastCell = wks.Cells(lngLastRow, intLastColumn)
WHEN I get the error, which so far has been infrequent, it happens there.
I see that the LastCell is a user defined function.
The error states that it's an "application defined, or object defined error."
I.e.,
LastCell = nothing
wks.cells(lngLastRow, intLastColumn) = <application defined, or object
defined error>
lngLastRow = 39
intLastColumn = 0
Would you please explain to me
1- why this would happen.
2- how to fix this from occurring in the future.
Thank you.
----------------------------------------------------------------------------
Sub CompactAllSheets()
Dim wks As Worksheet
'Dim lngVisible As Long
For Each wks In Worksheets
'lngVisible = wks.Visible
CompactSheet wks
'wks.Visible = lngVisible
Next wks
End Sub
Public Sub CompactSheet(Optional ByVal wks As Worksheet)
Dim rng As Range
If wks Is Nothing Then Set wks = ActiveSheet
Set rng = LastCell(wks)
wks.Range(rng.Offset(0, 1), wks.Cells(1,
Columns.Count)).EntireColumn.Delete
wks.Range(rng.Offset(1, 0), wks.Cells(Rows.Count, 1)).EntireRow.Delete
End Sub
Public Function LastCell(Optional ByVal wks As Worksheet) As Range
Dim lngLastRow As Long
Dim intLastColumn As Integer
If wks Is Nothing Then Set wks = ActiveSheet
On Error Resume Next
lngLastRow = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
intLastColumn = wks.Cells.Find(What:="*", _
After:=wks.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
On Error GoTo 0
If lngLastRow = 0 Then
lngLastRow = 1
intLastColumn = 1
End If
Set LastCell = wks.Cells(lngLastRow, intLastColumn)
End Functio
--------------------------------------------------------------------------------