Tuesday, January 23, 2018

MACRO to List Out All Tab Names Along With Field Header Name

Some times we need spreadsheet information at one place, information like :
  1. All tab Names available in spreadsheet
  2. All Header Names
This is because one spreadsheet can have many tabs in it and it is not sure that all tabs having same number of header columns. This article can be helpful who are looking for all information at one place. This kind of information is useful in automation programs, to write/update the spreadsheet through automation.

More possibilities are at run time we are not aware of the structure of spreadsheet.

This kind of information further can be used for some automation process (specially in IT industry), since automation can save TIME and MONEY.

One approach, i tried we can use Pentaho Tool (Open Source ETL Tool) for this, but some where this tool not use full where spreadsheet size cross 1GB. Because in my end Pentaho needs 24GB of JVM space to extract data from spreadsheet.

To achieve this we have designed Macro VBA program, which can perform this tasks in minutes, no matters what the size is.

Pre-requisite :
Save your Spreadsheet in macro enable format, if it is not.

Macro Code:

Sub ListMeta()
    Dim Ws As Worksheet
    Dim MetaWS As Worksheet
    Dim HeaderRange As Range
    Dim FieldCount As Integer
    Dim RowNo As Long
    Dim Spreadsheet As Workbook

    With Application
        .Calculation = xlCalculationManual
        .ScreenUpdating = False
    End With

    ''''''******* Delete sheet "MetaData-Sheet" ********** 
    Application.DisplayAlerts = False
    On Error Resume Next
    On Error GoTo 0
    Application.DisplayAlerts = True

    Set Spreadsheet = ThisWorkbook
    Set MetaWS = Spreadsheet.Worksheets.Add
    ' Add Metadata Sheet
 MetaWS.Name = "MetaData"

    RowNo = 1

    For Each Ws In Spreadsheet.Worksheets
        If Ws.Name <> MetaWS.Name And Ws.Visible Then
            FieldCount = 1
            RowNo = RowNo + 1
            'Copy the sheet name in the A column
            MetaWS.Cells(RowNo, 1).Value = Ws.Name

            For Each HeaderRange In Ws.Range("A1,B1,C1,D1,E1,F1,G1,H1,I1,J1,K1,L1")  ' you can change WS range as per your requirement
                FieldCount = FieldCount + 1
                MetaWS.Cells(RowNo, FieldCount).Formula = _
                "='" & Ws.Name & "'!" & HeaderRange.Address(False, False)
            Next HeaderRange

        End If
    Next Ws


    With Application
        .Calculation = xlCalculationAutomatic
        .ScreenUpdating = True
    End With
End Sub

No comments:

Post a Comment

web stats