# “Pivoting” data with VBA

I've attempted to erite some VBA for this this question. The output is OK

but the code is not very elegant. I'm happy-ish with creating unique list of names and certificates, but the rest seems rather ugly. I'd love to learn how to make it more elegant and programmer-like (and less amateur-like-crap).

Sub PivotData()

Dim rng As Range, cll As Range
Dim arr As New Collection, a
Dim var() As Variant
Dim l As Long
Dim lRow As Long, lCol As Long

l = 1

Set rng = Range("A2:C7")

' Create unique list of names
var = Range("A2:A7")
On Error Resume Next
For Each a In var

Next
For l = 1 To arr.Count
Cells(l + 1, 5) = arr(l)
Next
Set arr = Nothing

' Create unique list of certificates
var = Range("B2:B7")
For Each a In var
Next
For l = 1 To arr.Count
Cells(1, 5 + l) = arr(l)
Next
Set arr = Nothing
On Error GoTo 0

' Ugly code, how to make it more elegant?
Range("F2").FormulaArray = _
"=IFERROR(INDEX(R2C3:R7C3,MATCH(1,((R2C1:R7C1=RC5)*(R2C2:R7C2=R1C)),0)),"""")"

With Range("F2")
lRow = .CurrentRegion.Rows.Count
lCol = .CurrentRegion.Columns.Count + 4
End With

Range("F2:F" & lRow).FillDown
Range(Cells(2, 6), Cells(lRow, lCol)).FillRight

End Sub


## Fully Qualify Ranges

Your code assumes that the correct worksheet will be active when the code is ran. You should get in the habit of Fully Qualifying all range references. This will ensure that your code will work as intended no matter what worksheet is activated.

Technically, to be fully Fully Qualified a range needs to be referenced by workbook and worksheet.

ThisWorkbook.Worksheets("Sheet1").Range ("A2:C7")

Or

Workbooks("Some Book").Worksheets("Sheet1").Range ("A2:C7")

But in general it is acceptable to exclude the workbook if you are not going to be working with multiple workbooks.

Worksheets("Sheet1").Range ("A2:C7")

With statement blocks should be used so that you don't have to repeatedly requalify your ranges.

With ThisWorkbook.Worksheets("Sheet1")

For Each a in .Range ("A2:C7")

## Dynamic Ranges and Relative References

Dynamic Ranges should be used when working with records. In this way, you will not have to rewrite you code every time a recorded is added or deleted.

This applies to both ranges

With ThisWorkbook.Worksheets("Sheet1")
With .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
For Each a In .Cells
Next
End With
End With


and formulas and FormulaArray

Range("F2").FormulaArray = "=IFERROR(INDEX(OFFSET($C1,1,0,COUNTA($A:$A)-1,1),MATCH(1,((OFFSET($A1,1,0,COUNTA($A:$A)-1,1)=$E2)*(OFFSET($B1,1,0,COUNTA($A:$A)-1,1)=F$1)),0)),"""")"  Having the macro hard the ranges for the FormulaArray is an acceptable middle ground. I would do this to prevent the formulas from slowing up the workbook. ## Error Handling It is best to reduce the scope of On Error Resume Next as much as possible. This will give you better information when something goes wrong. On Error Resume Next For Each a In var arr.Add a, a Next On Error GoTo 0  Or For Each a In var On Error Resume Next arr.Add a, a On Error GoTo 0 Next  ## Variable Naming Don't not use l as a variable name. It is too hard to distinguish from 1. l = 1 does nothing. The For l = 1 initiates l to 1. arr should only be used to name arrays variables. Personally, I default to data, result or results. Although there is nothing wrong with a, I prefer v, key, or item. ## Alternate Methods Here are some other ways of pivoting the data without using worksheet formulas. ## Indexing Array Using ArrayList to Sort Headers This uses ArrayList to store and sort the headers. The position of the headers in the ArrayList is used as indices for a 2 dimensional array. Sub PivotDataIndexedArray() Dim key As Variant, data() As Variant Dim rowHeaders As Object, columnHeaders As Object Set rowHeaders = CreateObject("System.Collections.ArrayList") Set columnHeaders = CreateObject("System.Collections.ArrayList") With ThisWorkbook.Worksheets("Sheet1") With .Range("A2", .Range("A" & .Rows.Count).End(xlUp)) For Each key In .Value If Not rowHeaders.Contains(key) Then rowHeaders.Add key Next For Each key In .Offset(0, 1).Value If Not columnHeaders.Contains(key) Then columnHeaders.Add key Next data = .Cells.Resize(, 3).Value End With Dim results() As Variant Dim n As Long ReDim results(1 To rowHeaders.Count + 2, 1 To columnHeaders.Count + 2) 'Add names rowHeaders.Sort For n = 0 To rowHeaders.Count - 1 results(n + 2, 1) = rowHeaders(n) Next 'Add categories columnHeaders.Sort For n = 0 To columnHeaders.Count - 1 results(1, n + 2) = columnHeaders(n) Next Dim r As Long, c As Long 'Add dates For n = 1 To UBound(data) r = rowHeaders.IndexOf(data(n, 1), 0) c = columnHeaders.IndexOf(data(n, 2), 0) results(r + 2, c + 2) = data(n, 3) Next .Range("F1").Resize(UBound(results), UBound(results, 2)).Value = results End With End Sub  ## ADODB CrossTab Query An ADODB.Connection query can be used to pivot the data. The source data should be the only data on the worksheet, otherwise, you would have to specify the datas' range on the worksheet in the query (e.g [Sheet1$A1:C7]).

Sub PivotDataADODBQuery()
Const SQL As String = "TRANSFORM First([Date])" & vbNewLine & _
"SELECT [Name]" & vbNewLine & _
"FROM [Sheet1\$]" & vbNewLine & _
"GROUP BY [Name]" & vbNewLine & _
"PIVOT [Certificate];"

Dim conn As Object
Dim rs As Object

conn.ConnectionString = "Provider=Microsoft.ACE.OLEDB.12.0;Data Source='" & ThisWorkbook.FullName & "';Extended Properties='Excel 12.0;HDR=YES;IMEX=1';"
conn.Open

Set rs = conn.Execute(SQL)

With ThisWorkbook.Worksheets("Sheet2")
.Cells.ClearContents

Dim c As Long

For c = 0 To rs.Fields.Count - 1
.Cells(1, c + 1).Value = rs.Fields(c).Name
Next

.Range("A2").CopyFromRecordset rs
End With

rs.Close
conn.Close

End Sub


I would like to add a few more pieces of advice to what @TinMan has already provided.

## Naming

Good naming is one of the most useful and at the same time hardest things in programming. When you have to come back to your procedure 6 months in the furture, you will thank yourself for using descriptive names. In this case, the procedure is relatively short so that understanding what it does is not too hard, but in more complicated code, good names can make a huge difference.

Because of this, my advice is to go beyond the advise @TinMan has provided and to generally use descriptive names. (It is no problem if they get longer in the process.) E.g. the name rng does not really tell you anything about what it is; calling it sourceRange would certainly convey its purpose better.

## Single Responsibility Principle

Another good guiding principle is the so called single responsibility principle. In short, it says that a usint of code should always only be responsible for one and only one thing. This makes it a lot easier to understand and modify code.

Getting this right is rather hard. However, there is a one rough guidline that can help: whenever you have the urge to add a header comment, you probably want to extract a procedure or function for whatever is done in the section.

In your case, one responsibility is to know how to extract values from a range. You could define a function to do that as follows.

Private Function DistinctValues(inputRange As Excel.Range) As Collection
Dim allValues() As Variant
allValues = inputRange.Value

Dim uniqueValues As Collection
Set uniqueValues = New Collection

Dim currentValue As Variant
For Each currentValue In allValues
On Error Resume Next
On Error Goto 0
Next
Set DistinctValues = uniqueValues
End Function


If you ever want to change how to get distinct values, e.g. using a Scripting.Dictionary, you just have to change it in this one place. Moreover, your code is easier to understand if instead of

var = Range("B2:B7")
For Each a In var
Next


you have

Dim certificatesRange As Excel.Range
Set certificatesRange = Range("B2:B7")

Set distinctCertificates = DistinctValues(certificatesRange)


You could also separate the actual assembling of the new table into a procedure that takes some base point, e.g. the upper-left corner of the target range, a collection of column headers, one of row headers and the data source range.

With this, let us call it BuildPivotTable, your top procedure would look something like this:

Public Sub PivotData
Dim sourceRange As Excel.Range
Set sourceRange = Range("A2:C7")

Dim targetRange As Excel.Range
Set targetRange = ActiveSheet.Range("E1")

End Sub


This separates getting the data from doing things with it. Should you want to change where you get your data, you will no longer have to find the appropriate passages between the code doing things with the data. You can even further enhance this by extracting the passages getting the various ranges into their own functions responsible to know where to get the particular data from.

Again, this is not that cruicial for this size of method, but as things grow larger, which tends to happen rather fast whan adding functionality to things, a good separation of responsibilities can help a lot; it certainly justifies the extra code you have to write to achieve it.

## Do not Reuse Variables For Different Things

In your code, you first use the variable arr for distinct names, then for distinct certificates. This makes it harder to follow what the the collection alrady contains and actively hinders good nameing: you cannot name it after what its purpose is if it has multiple ones.

It really does not cost a lot to generate yet another object. So such micro-optimizations should be avoided in favor of ease of reading the code.

## Declare Variables Close to Their First Usage

Somewhat related to the last point, it is usually better to declare variables as close to their first usage as possible. This has the advantage that you cannot accidentaly add an access to the variable before that point (The compiler will yell at you.) and that you can be sure at that point that you have a clean object. E.g. a collection will not already contain something.

I know that this contradicts VBA style guids. However, those have been written in the 90s and which practices are deemed useful has involved in the past two decades.

Note that this guideline is much less relevent in short methods following the single responsibility principle.

## Data Input

After the general pieces of advice applicable to basically all programming languages, let me come to some more Excel and VBA specific point.

@TinMan already pointed out to possible enhancemets to make the code work with dynamic ranges of data. I would like to add two options: names ranges and list objects.

### Named Ranges

I am sure you are aware that you can name ranges in Excel either by writing in the address field in the top left or using the names manager in the formulas tab. You can use these names to specify ranges. If you define a named range Names as A2:A7, you can get the range for your names via Worksheets("Sheet1").Range("Names"), which makes you independent from the specific design of the source sheet.

### Tables

Even better would be to turn the input range into an Excel table, which we will call SourceTable. Then, you can access it as a ListObject via WorkSheets("Sheet1").ListObjects.Item("SourceTable"). Moreover, if you add another row, it will simply expand to also contain the new row. This is a lot more convenient than the approach with names ranges, which have to be adjusted to deal with new rows at the bottom.

## You can Save the Sheet You Are Working With in a Variable

@TinMan already suggested using a With block to hold the worksheet you are working with. However, that will not work well when you have to pass it to some method. Instead, you can simply Set assigne the worksheet to a varable of type Excel.Worksheet.

## Explicitly Calling Default Members

Default members are members on objects that get used automatically when the object is used in a Let assignmant, i.e. an assignment without the Set keyword. They are a source of a lot of surprising behaviour, and bugs. Thus, you should always prefer to call the curresponding member explicitly. For Range, this means using Range.Value. In Cells(l + 1, 5) = arr(l) you actually call Cells(l + 1, 5).Value = arr(l), provided arr(l) contains a value type. If it contained a Range. the call would translate to Cells(l + 1, 5).Value = arr(l).Value.

## Iterating Collections

Since there is not too much data in this example it is not rally a performance problem, but Collections are not designed to be iterated using indized. You should use a For Each loop instead. Unfortunately, it is not possible to use value types as the type for the item to pick from the loop. However, every object type and Variant will work.

## As New is Usually Not a Good Idea

You actually use the capabilitis of the As New declaration arr As New Collection, which is not seen to often. This declaration has the rather surprising effect of implicitly adding If arr Is Nothing Then Set arr = new Collection in front of every access to arr.

Although this can be used here to clear the variable by setting it to Nothing, it would be much clearer to simply set it to New Collection instead.

Because this behaviour is surprising to most poeaple, I would generally advise against using As New declarations. Moreover, it hurts performance a bit because of the constant checks against Nothing.

## Declare the Type of All Variables

It is already good to see that you declared the type of nearly all variables. However, you did not explicitly declare a as a Variant. This lets is vanish against the other declarations all using an As Type declaration.

• Good Stuff! FYI: I decided to write PivotDataIndexedArray() as a single subroutine because I felt that passing the ranges to another function might be a little confusing, in conjunction with, my use of With Statements. In retrospect, I probably should have used some temp variables to pass the information and explained the SRP myself. – TinMan Nov 20 '18 at 0:12

You can try something along these lines where you nest your formula calls:

Range("F2").FormulaArray = _
"=IFERROR(" _
& "INDEX(" _
& "R2C3:R7C3," _
& "MATCH(" _
& "1," _
& "((R2C1:R7C1=RC5)*(R2C2:R7C2=R1C))," _
& "0))," _
& """"")"


But the way you have it currently is not that bad

Also would highly suggest wrapping code into a With block and adding .'s to your Ranges and Cells to protect against errors from bad references.