Excel‎ > ‎

Analyse corruption and issue with your excel file





Some of the following VBA source code was given to me by Microsoft Support. I have modified, and improved on it to make it clearer and with better code. It is one of the most useful tool to find the issue in some workbook. It will write on a text file in your c:/test folder. You will have to create such folder if it does not exists.


Option Explicit

Sub Analyze_Workbook_In_One_File()
    On Error GoTo 0
    Dim currentDirectory
    Dim sht
    Dim x As Integer
    Dim ver As String
    Dim y, z
    Dim var
    Dim varLen
    Dim wbName
    Dim fName As String
    Dim wbExt
    Dim styCount
    Dim msg
    Dim sp
    Dim ref As Reference
    Dim shtCount
    Dim shtHidden
    Dim shtName, shtType
    Dim startTime, endTime, totTime
    Dim sty
    Dim styCount2, zz
    Dim nmName
    Dim nmRefersTo
    Dim nmValue
    Dim nmCount
    Dim nm As Name
    Dim nmRefersToLength
    Dim shpCount, totalShapeCount
    Dim shp As Shape
    Dim shpTLC As String
    Dim shpVisible
    Dim urRows As Double
    Dim urColumns As Double
    Dim urTotalCells As Double
    Dim chTotal, lnTotal, ctComponents
    Dim frmCount
    Dim optionTest
    Dim aLinks, i
    Dim printFormulas
    Dim startType
    Dim xx, objTop, objLeft, objHeight, objWidth, badCount
    Dim obj As Object
    Dim vw As CustomView
    Dim wb As Workbook
    Dim us
    Dim commentCount
    Dim cmmt
    Dim str1, str2, cellError
    Dim cel, celFormula, formulaCount, celValue
    Dim qName
    Dim qType
    Dim qConnection
    Dim qCommandText
    Dim qCount
    Dim q As QueryTable
    Dim qDestination
    Application.EnableEvents = False
    currentDirectory = CurDir


    ChDir "C:\Test"
    ChDir currentDirectory



    printFormulas = MsgBox("Do You Want to Print Out All Formulas and Cells with Errors?" & Chr(10) & Chr(13) & "This may take a long time, 30 minutes or more.", vbYesNo + vbCritical, "PRINT FORMULAS?")
    Application.ScreenUpdating = False


    sp = "   :   "

    wbName = ActiveWorkbook.Name
    wbExt = InStr(1, wbName, ".")
    wbName = Left(wbName, wbExt - 1)
    'Debug.Print wbName
    fName = "C:\Test\Analyze_Workbook_In_One_File_" & wbName & ".txt"
    On Error Resume Next
    'Since the file does not exists, if there are an error there, it should be ignored
    Kill fName
    On Error GoTo 0
    fOpenOutput fName
    '=========================================================

    msg = "Checking the Age of the Workbook , the path length, and the Author."

    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "------------------------------------------------"
    fPrint ""
    '=========================================================
    fPrint ""
    fPrint "---------------------" & ActiveWorkbook.Name & "--------------------"
    fPrint ""
    fPrint "---------------------" & ActiveWorkbook.FullName & "--------------------"
    fPrint ""
    For Each z In ActiveWorkbook.BuiltinDocumentProperties
        y = y + 1
        Select Case y
        Case 3
            fPrint "---------------------" & z.Name & "  :  " & z.Value & "--------------------"
            fPrint ""
        Case 11
            fPrint "---------------------" & z.Name & "  :  " & z.Value & "--------------------"
            fPrint ""
        Case Else
        End Select

    Next
    '=========================================================

    msg = "SHEETS AND VISIBILITY  - looking for hidden and very hidden sheets that the customer may not know are there."

    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "------------------------------------------------"
    fPrint ""
    fPrint "This workbook has " & ActiveWorkbook.Sheets.Count & "  sheets."
    fPrint "Sheet Name" & sp & "Sheet Type" & sp & "Visiblity"  '& sp & "Sheet Type"

    For Each sht In ActiveWorkbook.Sheets
        shtCount = shtCount + 1
        shtHidden = sht.Visible
        If shtHidden = 0 Then ver = "Hidden"
        If shtHidden = 2 Then ver = "Very Hidden by Code"
        If shtHidden = -1 Then ver = "Visible"

        shtName = sht.Name
        shtType = TypeName(sht)
        If (TypeName(sht) = "Worksheet") And (sht.Type = 3) Then
            shtType = "XL4 Macro Sheet"

        End If
        If ver <> "Visible" Or shtCount > 200 Then
            fPrint shtCount & sp & sht.Name & sp & shtType & sp & ver
        End If
    Next


    '=========================================================

    msg = "STYLES - XL2003 has 8 default styles.  XL2007 has 50 default styles.  Checking for numerous Styles or for styles with names using unprintable characters or that might not be 'User Friendly'"
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "-------------------------------------------------"
    fPrint "This workbook has " & ActiveWorkbook.Styles.Count & " Styles."
    fPrint ""

    styCount2 = ActiveWorkbook.Styles.Count

    For zz = styCount2 To 1 Step -1
        styCount = styCount + 1
        fPrint styCount & sp & ActiveWorkbook.Styles(zz).Name & sp & "BuiltIn:=" & ActiveWorkbook.Styles(zz).BuiltIn
        If ActiveWorkbook.Styles(zz).BuiltIn = False Then
      '      ActiveWorkbook.Styles(zz).Delete   'Un-Comment this if you want to delete styles.
        End If


    Next
    '=========================================================
    msg = "DEFINED NAMES - Looking for Defined Names that have lost their reference (#REF), start with '\' (Originated in Lotus 123), have unprintable characters (Corrupt), dont look like they were created by a human (Created by a virus or an addin), or an exceedingly large number of Names (more than 500)."
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "-------------------------------------------------"
    fPrint ""
    fPrint "Total Names are : " & ActiveWorkbook.Names.Count
    fPrint ""
    fPrint "Name Count : Name : RefersTo : Visible (True / False) : Length of RefersTo "

    For Each nm In ActiveWorkbook.Names
        'nm.Delete
        nmName = nm.Name
        nmValue = nm.Value
        nmRefersTo = nm.RefersTo
        nmRefersToLength = Len(nmRefersTo)
        nmCount = nmCount + 1
        'If (InStr(1, nmRefersTo, "#REF") > 0) Or (InStr(1, nmValue, "#") > 0) Then
        If (InStr(1, nmRefersTo, "#REF") > 0) Or (nmRefersToLength > 200) Then

            fPrint "                BAD!!!!           " & nmCount & " : " & nmName & sp & "'" & nmRefersTo & sp & nm.Visible & sp & nmRefersToLength
            'nm.Delete 'Un-Comment this if you want to delete bad names.
        Else
            If nmCount > 500 Then
                'Debug.Print nmCount & sp & nmName & sp & nmRefersTo & sp & nm.Visible
                fPrint nmCount & sp & nmName & sp & "'" & nmRefersTo & sp & nm.Visible & sp & nmRefersToLength
                'If nm.Visible = False Then nm.Delete  'Un-Comment thios if you want to delete hidden names.
            End If
        End If
    Next
    '=========================================================
    msg = "SHAPES - Looking for shapes with Zero (0) Width or Height. Looking for Sheet ShapeCount to be a huge number > 200.  Looking for shapes on a sheet to be in the same location, same Top and Left."
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "-------------------------------------------------"
    fPrint ""

    UnHideAllColumnsAndRows
    fPrint "Shape Count " & sp & "Sheet Shape Count" & sp & "Sheet Name" & sp & "Shape Name" & sp & "Shape Top" & sp & "Shape Left" & sp & "Shape Height" & sp & "Shape Width" & sp & "Shape Visible" & sp & "Shape Top Left Cell"
    For Each sht In ActiveWorkbook.Worksheets
        sht.Visible = True


        shtName = sht.Name
        For Each shp In sht.Shapes

            If shp.Visible = msoFalse Then
                shpVisible = "Hidden"
            Else
                shpVisible = "Visible"
            End If
            On Error Resume Next
            shpTLC = shp.TopLeftCell.Address

            totalShapeCount = totalShapeCount + 1
            shpCount = shpCount + 1
            If (shp.Height = 0) Or (shp.Width = 0) Then

                fPrint "BAD!!!    " & sp & totalShapeCount & sp & shpCount & sp & sht.Name & sp & shp.Name & sp & shp.Top & sp & shp.Left & sp & shp.Height & sp & shp.Width & sp & shpVisible & sp & shpTLC
            Else
                If totalShapeCount > 200 Then
                    fPrint totalShapeCount & sp & shpCount & sp & sht.Name & sp & shp.Name & sp & shp.Top & sp & shp.Left & sp & shp.Height & sp & shp.Width & sp & shpVisible & sp & shpTLC
                End If
            End If
        Next
        shpCount = 0
    Next

    '=========================================================
    msg = "USED RANGE - Looking for a large last number, then check to see if there is actually data there. A large Used Range causes a file to be unnecessarily big."
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "-------------------------------------------------"
    fPrint ""
    For Each sht In ActiveWorkbook.Worksheets
        sht.Select

        urRows = sht.UsedRange.Rows.Count
        urColumns = sht.UsedRange.Columns.Count
        urTotalCells = urRows * urColumns
        'urTotalCells = CStr(urTotalCells)
        If urTotalCells > 100000 Then

            fPrint "                LARGE USED RANGE" & sp & sht.Name & sp & sht.UsedRange.Address & sp & urTotalCells
        Else
            '     fPrint sht.Name & sp & sht.UsedRange.Address & sp & urTotalCells
        End If

    Next
    '=========================================================
    msg = "LINKS - Looking for two (2) or more links to the same workbook, or for a large number of links."
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "-------------------------------------------------"
    fPrint ""

    aLinks = ActiveWorkbook.LinkSources(xlOLELinks)
    If Not IsEmpty(aLinks) Then
        fPrint "....OLE Links...."
        For i = 1 To UBound(aLinks)

            fPrint i & sp & CStr(aLinks(i))
        Next
    Else: End If


    aLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(aLinks) Then
        fPrint "....Excel Links...."
        For i = 1 To UBound(aLinks)
            fPrint i & sp & CStr(aLinks(i))
        Next
    Else: End If


    '=========================================================
    msg = "LinesAndCharacters - Checking for over 20K of code in a code module. It has been observed that modules that have over 20K of code will ocassionally hang or crash Excel.  If just one function is used in the Module, all the code in the Module has to be loaded at once.  If this area is blank, it is because the VBA Project is password protected for viewing, or that 'Trust Access to the VBA Project' is not checked in Macro Security."
    fPrint "                                                "
    fPrint msg
    fPrint "                                                "

    fPrint ""

    ctComponents = ActiveWorkbook.VBProject.VBComponents.Count
    For x = 1 To ActiveWorkbook.VBProject.VBComponents.Count
        ver = ActiveWorkbook.VBProject.VBComponents(x).Name

        For y = 1 To ActiveWorkbook.VBProject.VBComponents(x).CodeModule.CountOfLines
            var = ActiveWorkbook.VBProject.VBComponents(x).CodeModule.Lines(y, 1)

            varLen = varLen + Len(var)
        Next


        If varLen > 20000 Then
            fPrint ver & ":" & ActiveWorkbook.VBProject.VBComponents(x).CodeModule.CountOfLines & " lines of code."
            fPrint "BAD!!!!!!!!!!!           " & ver & " has " & varLen & " characters"
        Else
            '           fPrint ver & ":" & ActiveWorkbook.VBProject.VBComponents(x).CodeModule.CountOfLines & " lines of code."
            '         fPrint ver & " has " & varLen & " characters"
        End If
        lnTotal = lnTotal + ActiveWorkbook.VBProject.VBComponents(x).CodeModule.CountOfLines
        chTotal = chTotal + varLen
        varLen = 0
    Next
    fPrint ""
    fPrint "This Workbook has " & ctComponents & " Code Modules."
    fPrint "This workbook has " & lnTotal & " lines of code and " & chTotal & " characters."
    fPrint ""
    '=========================================================
    msg = "OPTION EXPLICIT TEST - if Option  Explicit is not at the top of every code page, it encourages Logic Errors. If this area is blank, it is because the VBA Project is password protected for viewing, or that 'Trust Access to the VBA Project' is not checked in Macro Security."
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "-------------------------------------------------"
    fPrint ""
    fPrint ""

    For x = 1 To ActiveWorkbook.VBProject.VBComponents.Count
        ver = ActiveWorkbook.VBProject.VBComponents(x).Name
        ' Debug.Print ver
        optionTest = False
        For y = 1 To ActiveWorkbook.VBProject.VBComponents(x).CodeModule.CountOfLines
            var = ActiveWorkbook.VBProject.VBComponents(x).CodeModule.Lines(y, 1)
            varLen = varLen + Len(var)
            If InStr(1, var, "Option Explicit") > 0 Then
                optionTest = True
            Else: End If

        Next

        If (optionTest = False) And (varLen > 0) Then
            fPrint ver & " does not have Variable Declaration Enforced"

        Else
        End If
    Next
    '=========================================================
    msg = "VARIABLES...looking for names that might be reserved words, like COUNT, SHEET, ROW..etc. More is coming on that issue  If this area is blank, it is because the VBA Project is password protected for viewing, or that 'Trust Access to the VBA Project' is not checked in Macro Security."
    fPrint "                                                "
    fPrint msg
    fPrint "                                                "
    fPrint ""
    fPrint ""


    '    For x = 1 To ActiveWorkbook.VBProject.VBComponents.Count
    '        ver = ActiveWorkbook.VBProject.VBComponents(x).Name
    '        startType = False
    '
    '        For y = 1 To ActiveWorkbook.VBProject.VBComponents(x).CodeModule.CountOfLines
    '            var = ActiveWorkbook.VBProject.VBComponents(x).CodeModule.Lines(y, 1)
    '            '-----------------------------------Variables and Functions----------------------
    '            If (InStr(1, var, "Dim") > 0) Or (InStr(1, var, "Private") > 0) Or (InStr(1, var, "Public") > 0) Or (InStr(1, var, "Function") > 0) Then
    '                fPrint ver & " : " & var
    '
    '            End If
    '            '---------------------------Public and Private Types ----------------------------
    '            If (InStr(1, var, "Public Type") > 0) Or (InStr(1, var, "Private Type") > 0) Then
    '                startType = True
    '                'fPrint "startType = True"
    '            End If
    '            '------------------------ End of Type
    '            If startType = True Then
    '                fPrint ver & " : " & var
    '            End If
    '
    '            If (InStr(1, var, "End Type") > 0) Then startType = False
    '            'fPrint "startType = False"
    '
    '
    '
    '        Next
    '    Next


    '=========================================================
    msg = "OBJECT REFERENCES...looking for object references that are set and not set to Nothing.  If this area is blank, it is because the VBA Project is password protected for viewing, or that 'Trust Access to the VBA Project' is not checked in Macro Security."
    fPrint "-------------------------------------------------"
    '  fPrint msg
    fPrint "-------------------------------------------------"
    fPrint ""
    fPrint ""
    For x = 1 To ActiveWorkbook.VBProject.VBComponents.Count
        ver = ActiveWorkbook.VBProject.VBComponents(x).Name
        'Debug.Print ver
        For y = 1 To ActiveWorkbook.VBProject.VBComponents(x).CodeModule.CountOfLines
            var = ActiveWorkbook.VBProject.VBComponents(x).CodeModule.Lines(y, 1)
            If InStr(1, var, "Set") > 0 Then
                '     fPrint ver & " : " & var
            Else: End If
        Next
    Next

    '=========================================================
    msg = "VBA REFERENCES...looking for VBA references.  If this area is blank, it is because the VBA Project is password protected for viewing, or that 'Trust Access to the VBA Project' is not checked in Macro Security."
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "-------------------------------------------------"
    fPrint ""

    For Each ref In ActiveWorkbook.VBProject.References
        fPrint ref.Description & " : " & ref.FullPath
        fPrint ref.Name & ":" & ref.GUID & ":" & ref.Major & ":" & ref.Minor
        fPrint ""
        'Debug.Print ref.Name & ":" & ref.GUID & ":" & ref.Major & ":" & ref.Minor
        'Debug.Print ref.FullPath
        'Debug.Print ref.Description

    Next

    '=========================================================
    msg = "Count of Controls on Forms. Limit is  If this area is blank, it is because the VBA Project is password protected for viewing, or that 'Trust Access to the VBA Project' is not checked in Macro Security."
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "There can be a maximum of 254 different control names per form. A control array counts as one name.  Every form that has more than 240 controls is displayed here"
    fPrint "-form name-control name-top-left-Height-Width"
    fPrint ""

    On Error Resume Next

    sp = " : "

    For Each obj In ActiveWorkbook.VBProject.VBComponents
        If obj.Type = 3 Then

            Debug.Print obj.designer.Controls.Count
            frmCount = obj.designer.Controls.Count


        End If

        On Error GoTo 0
        If frmCount > 240 Then
            fPrint obj.Name & " : " & frmCount & sp
        End If
        On Error Resume Next
        For xx = 1 To frmCount
            objTop = obj.designer.Controls(xx).Top
            objLeft = obj.designer.Controls(xx).Left
            objHeight = obj.designer.Controls(xx).Height
            objWidth = obj.designer.Controls(xx).Width
            If (objHeight = 0) Or (objWidth = 0) Then
                badCount = badCount + 1
                fPrint badCount & sp & "          BAD!!!!           " & obj.Name & sp & obj.designer.Controls(xx).Name & sp & objTop & sp & _
                       objLeft & sp & objHeight & sp & objWidth

                'Stop
            Else
                '   fPrint "                     " & obj.designer.Controls(xx).Name & sp & objTop & sp & _
                    objLeft & sp & objHeight & sp & objWidth
            End If
        Next
        frmCount = 0
    Next

    '=========================================================

    fPrint "-------------------------------------------------"
    msg = "CUSTOM VIEWS - looking for Custom Views. Custom Views are created in a Shared Workbook for every user that Accesses the workbook. They can also be created manually, but this is not normally done."
    fPrint msg
    fPrint ""
    fPrint "This Workbook has " & ActiveWorkbook.CustomViews.Count & " Custom Views."
    fPrint ""
    fPrint ""

    For Each vw In ActiveWorkbook.CustomViews
        fPrint vw.Name & sp & vw.PrintSettings & sp & vw.RowColSettings
    Next

    '=========================================================
    msg = "Shared Users Left in File  ...looking for more than one user. More than one user will indicate that the file crashed and left all the User Names in the file.  It also tells when the user did this."
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "-------------------------------------------------"
    fPrint ""
    fPrint ""


    Set wb = ActiveWorkbook
    us = wb.UserStatus
    For x = 1 To UBound(us)
        fPrint us(x, 1) & sp & us(x, 2)
    Next





    '=========================================================

    msg = "Comments - Looking for unprintable characters, offensive words.  Comments that are blank, or outside the normal Used Range."
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "-------------------------------------------------"
    fPrint ""

    fPrint "Sheet Name : Comment Address : Comment Text"

    For Each sht In ActiveWorkbook.Worksheets
        sht.Select
        For Each cmmt In sht.Comments
            'Debug.Print sht.Name & sp & cmmt.Parent.Address & sp & cmmt.Text
            commentCount = commentCount + 1
            fPrint commentCount & sp & sht.Name & sp & cmmt.Parent.Address & sp & cmmt.Text
        Next
    Next
    '=========================================================
    msg = "Pivot Tables...more to be developed"
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint "-------------------------------------------------"
    fPrint ""
    For Each sht In ActiveWorkbook.Worksheets
        sht.Select
        For x = 1 To sht.PivotTables.Count
            'sht.Cells.Clear  'Uncomment this if you want to delete all Pivot Tables
            Debug.Print sht.Name & " : " & sht.PivotTables(x).Name & " : " & sht.PivotTables(x).DataBodyRange.CurrentRegion.Address
            fPrint sht.Name & " : " & sht.PivotTables(x).Name & " : " & sht.PivotTables(x).DataBodyRange.CurrentRegion.Address
        Next
    Next
    '=========================================================
    If printFormulas = vbYes Then
        msg = "Cells with Errors - Look at all cells to determine why it has an Error Value. Only one cell per sheet is normal to keep the code length down."
        fPrint "-------------------------------------------------"
        fPrint msg
        fPrint "-------------------------------------------------"

        For Each sht In ActiveWorkbook.Worksheets
            sht.Visible = True
            sht.Select
            ver = Cells.Find(What:="#", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
                             xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, _
                             SearchFormat:=False).Activate
            str1 = ActiveCell.Parent.Name & "|" & ActiveCell.Address


            Do
                ver = Cells.Find(What:="#", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
                                 xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True, _
                                 SearchFormat:=False).Activate
                Cells.FindNext(After:=ActiveCell).Activate
                'Debug.Print ActiveCell.Address
                'Debug.Print ActiveCell.Parent.Name
                str2 = CStr(ActiveCell.Parent.Name & "|" & ActiveCell.Address)
                'Debug.Print ver
                cellError = cellError + 1
                fPrint cellError & sp & str2
            Loop Until str2 = str1
        Next

        '=========================================================
        msg = "FORMULAS - List of all formulas, can be opened in Excel and Sorted."
        fPrint "-------------------------------------------------"


        fPrint msg
        fPrint "-------------------------------------------------"
        fPrint ""
        For Each sht In ActiveWorkbook.Worksheets
            sht.Visible = True
            sht.Select
            For Each cel In ActiveSheet.UsedRange
                celFormula = cel.Formula
                celValue = cel.Text
                If InStr(1, celFormula, "=") > 0 Then
                    formulaCount = formulaCount + 1
                    fPrint formulaCount & sp & sht.Name & sp & cel.Address & sp & celValue & sp & celFormula
                Else: End If
            Next
        Next




    Else: End If

    '=========================================================
    fPrint "-------------------------------------------------"
    msg = "Query Tables - List of all Query Tables and Type."
    fPrint "-------------------------------------------------"
    fPrint msg
    fPrint ""
    fPrint "Query Table Count  :  Sheet Name : Query Name : Query Destination : Query Type : Query Command Text"
    fPrint ""


    sp = "  :   "

    For Each sht In ActiveWorkbook.Worksheets

        For Each q In sht.QueryTables
            qCount = qCount + 1
            shtName = sht.Name
            qName = q.Name
            qDestination = q.Destination.Address(False, False)
            qType = GetQueryType(q.QueryType)
            qCommandText = GetCommandText(q)
            'Debug.Print shtName & sp & qName & sp & qDestination & sp & qType & sp & qCommandText
            fPrint qCount & sp & shtName & sp & qName & sp & qDestination & sp & qType & sp & qCommandText
            fPrint ""
        Next

    Next


    '=========================================================
    fPrint "-------------------------------------------------"

    '=========================================================
    fPrint "-------------------------------------------------"

    '=========================================================
    fPrint "-------------------------------------------------"

    Close


    '       MsgBox "You need to create a 'C:\Test' directory for this code to run.  The Output file will be in 'C\Test' and will contain the name of the workbook."



    ' If Err.Number = 35021 Then fPrint "Missing VBA Reference" & " : " & ref.GUID

    Application.EnableEvents = True
End Sub

Private Function GetQueryType(qt As XlQueryType) As String
    Select Case qt
    Case xlADORecordset
        GetQueryType = "ADO recordset"
    Case xlDAORecordset
        GetQueryType = "DAO recordset"
    Case xlODBCQuery
        GetQueryType = "ODBC"
    Case xlOLEDBQuery
        GetQueryType = "OLE DB"
    Case xlTextImport
        GetQueryType = "Text File"
    Case xlWebQuery
        GetQueryType = "Web Query"
    Case Else
        GetQueryType = ""
    End Select
End Function

Private Function GetCommandText(qt As QueryTable) As String
    If qt.QueryType = xlWebQuery Or qt.QueryType = xlTextImport Or qt.QueryType = xlADORecordset Or qt.QueryType = xlDAORecordset Then
        GetCommandText = ""
    Else
        GetCommandText = qt.CommandText
    End If
End Function


Private Sub UnHideAllColumnsAndRows()

    Dim sht As Worksheet
    Application.ScreenUpdating = False
    For Each sht In ActiveWorkbook.Sheets
        On Error Resume Next
        sht.Visible = True

        sht.Cells.EntireColumn.Hidden = False
        sht.Cells.EntireRow.Hidden = False
     
    Next
       On Error GoTo 0
End Sub


Sub cleanshape()
    Dim shp As Shape
    Dim sht As Worksheet
    For Each sht In Sheets
        For Each shp In sht.Shapes


            If (shp.Height = 0) Or (shp.Width = 0) Then


                shp.Delete

            End If
        Next
    Next
End Sub

Comments