How to create a report with headers at specific positions using Excel VBA. This is a reply to the following query:

Dr. Dinesh,

Hello. My name is Kiyoshi working for a bank. I have used several VBA coding examples you have put up on the web and these have been very helpful. I am however having one difficulty to solve the issue below.

I have a table with Team Name in one column and System Name in another column (Original Table below). In each row, one system is mapped to a team and because each team is using several different systems, systems used by each team is separated into multiple rows. I would like to know how I can merge the rows by team names with all systems in one row but in different lines (like New Table below). The new table should be created to a new worksheet.

Thank you very much for your help in advance.

Original Table:

New Table:

Watch the training video below before you work with the VBA code:

Watch this video on YouTube.

Sub createReport()
Dim lastrow As Long, erow As Long
Dim countfinance As Long, counthuman As Long, countsales As Long

countfinance = 0
counthuman = 0
countsales = 0

lastrow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Row

Sheet2.Cells.Clear

Sheet2.Range(“a1”) = “Team Name”
Sheet2.Range(“a1”).Font.Bold = True
Sheet2.Range(“b1”) = “System”
Sheet2.Range(“b1”).Font.Bold = True

For i = 2 To lastrow
If Sheet1.Cells(i, 1) = “Finance” Then
countfinance = countfinance + 1
Sheet1.Cells(i, 2).Copy
erow = Sheet2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
Sheet1.Paste Destination:=Worksheets(“Sheet2”).Cells(erow, 2)

ElseIf Sheet1.Cells(i, 1) = “Human Resources” Then
counthuman = counthuman + 1
Sheet1.Cells(i, 2).Copy
erow = Sheet2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
Sheet1.Paste Destination:=Worksheets(“Sheet2”).Cells(erow, 2)

ElseIf Sheet1.Cells(i, 1) = “Sales” Then
countsales = countsales + 1
Sheet1.Cells(i, 2).Copy
erow = Sheet2.Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
Sheet1.Paste Destination:=Worksheets(“Sheet2”).Cells(erow, 2)
End If

Next i

Application.CutCopyMode = False
Sheet2.Cells(2, 1) = “Finance”
Sheet2.Cells(countfinance + 2, 1) = “Human Resources”
Sheet2.Cells((countfinance + 2 + counthuman), 1) = “Sales”
Sheet2.Columns.AutoFit
Range(“a1”).Select

End Sub

If we wish to sort the data in sheet1 in ascending order we can use the following recorded macro code:
Sub Macro1()
‘
‘ Macro1 Macro
‘

‘
Sheet1.Range(“A2:B18”).Select
ActiveWorkbook.Worksheets(“Sheet1”).Sort.SortFields.Clear
ActiveWorkbook.Worksheets(“Sheet1”).Sort.SortFields.Add Key:=Range(“A2:A18”) _
, SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With ActiveWorkbook.Worksheets(“Sheet1”).Sort
.SetRange Range(“A1:B18”)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End Sub

Download a sample Excel file: