Some times we need spreadsheet information at one place, information like :
- All tab Names available in spreadsheet
- 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 ThisWorkbook.Worksheets("MetaData").Delete 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 MetaWS.UsedRange.Columns.AutoFit With Application .Calculation = xlCalculationAutomatic .ScreenUpdating = True End With End Sub
No comments:
Post a Comment