Automating Excel Column Headers
How to Automate Column Header Titles in Excel
Reports are not usually generated one time only. Typically, they are run over and over again on a monthly, weekly or daily basis. Performing this task manually is a complete waste of time better spent learning new coding techniques!
Column headers can be either copied and pasted or generated dynamically.
Data from SQL Server inserted into Excel sheet:
Worksheet Header contains the Column Headers to be inserted above.
Excel Copy and Paste Version of VBA Code
This code in a VBA Macro will simply copy and paste the row with the header from a different sheet (called Header, here) and paste it on our Data sheet after Inserting a new Row 1. As long as this information does not change, this is a quick way to get the job done.
Public Sub CopyHeader()
'header
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Sheets("Header").Select
Rows("1:1").Select
Selection.Copy
Sheets("Data").Select
Range("A1").Select
Sheets("Data").Paste
End Sub
Excel VBA Dynamic Column Header Names
This code will create an array of columns (letters + row1) to populate the headers from an ADODB recordset using a for loop. If the column names will change in the data source, it may be easier to manage the column headers dynamically as showe here:
Public Const DB_NAME As String = "AdventureWorks"
Public Const source As String = "Sales.usp_SalesPerformance"
Public Const GLOBAL_DB_CXN_STRING = "Provider=MSDataShape;Data Provider=SQLOLEDB;SERVER=####;DATABASE=" & DB_NAME & ";Integrated Security=SSPI"
Public Sub DynamicHeader()
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim cmd As ADODB.Command
Dim rng As Range
Dim stCell As Integer, iRecCount As Integer
Dim i As Integer, j As Integer
Dim stFields() As String
Dim arrSize As Integer
On Error GoTo errHandler
stCell = 1
arrSize = 8
ReDim Preserve stFields(arrSize)
For i = stCell To arrSize
stFields(i) = Chr(64 + i)
Next i
Set cn = New ADODB.Connection
cn.ConnectionString = GLOBAL_DB_CXN_STRING
cn.Open
Set cmd = New ADODB.Command
Set rs = New ADODB.Recordset
With cmd
.CommandType = adCmdStoredProc
.CommandText = source
.CommandTimeout = 300
.ActiveConnection = cn
'Connection object
Set rs = .Execute
End With
Do Until (rs.State = adStateOpen)
Set rs = rs.NextRecordset
Loop
ActiveWindow.Zoom = 80
Sheets("Data").Select
'Test to see if we have records
If Not (rs.BOF And rs.EOF) Then
'Copy recordset to the range
rs.MoveLast
rs.MoveFirst
Set rng = ThisWorkbook.ActiveSheet.Range("a1")
rng.CopyFromRecordset rs
End If
'insert header row
Rows("1:1").Select
Selection.InsertShift:=xlDown
'populate the header names
For j = stCell To arrSize
Range(stFields(j) & "1").Select
ActiveCell.FormulaR1C1 = rs.Fields(j - 1).Name
Next j
'set the header names to bold
Rows("1:1").Select
Selection.Font.Bold = True
'freeze the top row
Rows("1:2").Select
Range("A2").Activate
ActiveWindow.FreezePanes = True
'close out of our recordset and connections
Set rs = Nothing
Set cmd = Nothing
cn.Close
Set cn = Nothing
ExitHandler:
Exit Sub
errHandler:
errmsg = "Error: " & Err.Number & ":" & Err.Description
MsgBox errmsg, vbExclamation
Resume ExitHandler
End Sub
The Column Names from the Recordset are populated by iterating through an array to get the ADODB.Recordset .Name property and populate Row 1 using ASCII Char numbers 65 through 90 to get the letter into an array. Of course, if you exceed the alphabet limit, there is a trick to get the rows populated. Some automated column formatting would also help.
