Wiki

This page is read only. You can view the source, but not change it. Ask your administrator if you think this is wrong.
====== Microsoft Excel - Macros - Sheet - Clear a sheet but leave formulae on 2nd row ======

<code excel>
' Clears a sheet but leave formulae on 2nd row.
Sub Clear_Sheet1()

    Dim lastrow_Sheet1 As Long                ' Last row in the Sheet1 sheet
    Dim rng As Range


    ' Initialize global vars.
    Call Z00000_Init


    ' Ask user.
    'If ctrl_ask_before_running_subroutine = True Then
    '    If MsgBox("Clear the Sheet1 sheet?", vbYesNo) = vbNo Then Exit Sub
    'End If

    
    ' Update StatusBar.
    Application.StatusBar = "Clearing Sheet1 sheet..."


    With Workbooks(wb_name)
    
        With .Sheets("Sheet1")
        
            ' Activate the sheet.
            .Activate

    
            ' Get how many rows of data have been loaded into the sheet.
            lastrow_Sheet1 = .Cells(Rows.Count, 4).End(xlUp).Row
            ' Prevent line 2 being deleted - as this contains the formulae which need coping down later.
            If lastrow_Sheet1 < 3 Then
                lastrow_Sheet1 = 3
            End If
    
    
            ' Clear entire sheet, except for row 2 which contains formulae.
            .Range("A3:AT" & lastrow_Sheet1).ClearContents
    
        
            ' Clear fields loaded into the sheet.
            .Range("D2:D" & lastrow_Sheet1).ClearContents
            .Range("F2:I" & lastrow_Sheet1).ClearContents
            .Range("O2:O" & lastrow_Sheet1).ClearContents
            .Range("S2:AH" & lastrow_Sheet1).ClearContents
    
            
            ' Clear formatting.
            If ctrl_clear_formatting_as_well = True Then
                .Range("A3:AT" & lastrow_Sheet1).ClearFormats
            
                .Range("D2:D" & lastrow_Sheet1).ClearFormats
                .Range("F2:I" & lastrow_Sheet1).ClearFormats
                .Range("O2:O" & lastrow_Sheet1).ClearFormats
                .Range("S2:AH" & lastrow_Sheet1).ClearFormats
            End If
    
    
            ' Clear any double lines.  
            .Range("A1:AT" & lastrow_Sheet1).Borders.LineStyle = xlNone

            
            ' Reset font to standard.
            .Range("A3:AT" & lastrow_Sheet1).Font.name = Application.StandardFont

    
            ' This deletes empty rows at the bottom of the sheet.  Important to save after this is run to commit this change.
            ' This substantially reduces the size of the sheet, especially in larger Excel sheets going down to over 1 Million rows.
            '.Range("A" & lastrow_Sheet1 & ":AT" & Rows.Count).EntireRow.Delete
        
        
            ' Delete all unused black rows and columns in the sheet.
            DeleteUnusedOnSheet ("Sheet1")
            
        
            ' Control to confirm there is currently no data in the blue columns in the Sheet1 sheet.
            If WorksheetFunction.CountA( _
                .Range("D2:D" & lastrow_Sheet1), _
                .Range("F2:I" & lastrow_Sheet1), _
                .Range("O2:O" & lastrow_Sheet1), _
                .Range("S2:AH" & lastrow_Sheet1)) > 0 Then
                    Message "There is data still present in the blue columns in the Sheet1 sheet, these should be blank. Ensure they are empty before running this process."
                    Exit Sub
            End If
        
        End With
    End With


    ' Do calculation.
    With Application
        .Calculate
    End With


    ' Clear all objects.
    Set rng = Nothing

End Sub
</code>