Programming Samples

Click here to go to:



Excel VBA

Word VBA

MS Access

T-SQL

SSIS

SSRS

Power BI

Crystal Reports

SSAS

SQL Replication

C# Code

ASP .NET Code

Oracle PL/SQL

Database Diagramming


Back to Home Page


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:Excel Data

Worksheet Header contains the Column Headers to be inserted above.Copy Header Technique

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)

'populate the array with capital letters using ASCII codes 65 to 90 or less

  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.

Data with Headers