Help with this code
VBA Telemetry pings you when your VBA projects fail
Thanks Thanks:  0
Likes Likes:  0
Results 1 to 2 of 2

Thread: Help with this code

  1. #1
    Guest

    Default

     
    Hi,

    For the life of me I can't get this code to work. I have a lot of workbooks with worksheets where the usedrange of each sheet is something like A1:U23233 but there are only about 200 rows and 10 columns of data on each sheet. I have managed to set up this code which highlights all shades the real unused range in red (the final macro will delete the columns/rows and then save the file).

    The error occurs just after the comment Delete the unused columns with the error message Method Range of object _Worksheet failed.

    Any ideas?

    Sub SortAndSave()
    Dim sht As Worksheet, lngLastRow As Long, rngeFind As Range, lngLastCol As Long
    Dim rngeTemp As Range

    Set TheWorkbook = ActiveWorkbook
    For Each sht In TheWorkbook.Worksheets
    Set rngeFind = sht.Range(sht.UsedRange.Address).Find("*", , , , xlByRows, xlPrevious)
    lngLastRow = rngeFind.Row
    Set rngeFind = sht.Range(sht.UsedRange.Address).Find("*", , , , xlByColumns, xlPrevious)
    lngLastCol = rngeFind.Column + 1

    'Delete the unused columns
    sht.Range(Cells(1, lngLastCol), Cells(1, 256)).Interior.ColorIndex = 3

    'Now delete the unused rows
    sht.Range(Cells(lngLastRow, 1), Cells(65535 - lngLastRow, 1)).Interior.ColorIndex = 3 'EntireRow.Delete
    Next

    'The workbook has been sorted, now save it and close it

    'TheWorkbook.Close True

    End Sub



  2. #2
    Guest

    Default

      
    Don't worry I got it sorted.

    There were some blank sheets in the workbook and so rngeFind was Nothing. I don't know why the debugger was highlighting this line:-
    sht.Range(Cells(1, lngLastCol), Cells(1, 256)).EntireColumn.Delete

    but this code seems to work:-

    Sub SortAndSave()
    Dim sht As Worksheet, lngLastRow As Long, rngeFind As Range, lngLastCol As Long

    Set TheWorkbook = ActiveWorkbook
    For Each sht In TheWorkbook.Worksheets
    Set rngeFind = sht.Range(sht.UsedRange.Address).Find("*", , , , xlByRows, xlPrevious)

    If Not rngeFind Is Nothing Then

    lngLastRow = rngeFind.Row + 1

    Set rngeFind = sht.Range(sht.UsedRange.Address).Find("*", , , , xlByColumns, xlPrevious)
    lngLastCol = rngeFind.Column + 1

    'Delete the unused columns
    sht.Range(Cells(1, lngLastCol), Cells(1, 256)).EntireColumn.Delete

    'Now delete the unused rows
    sht.Range(Cells(lngLastRow, 1), Cells(65536, 1)).EntireRow.Delete
    End If
    Next

    'The workbook has been sorted, now save it and close it

    'TheWorkbook.Close True

    End Sub



User Tag List

Like this thread? Share it with others

Like this thread? Share it with others

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •  

 

 
DMCA.com