Visit my Youtube Channel
Note: This webpage is designed to accompany the Youtube video posted above. The video offers detailed explanation on all topics; while this webpage will serve as a repository for the code presented in the video.
This tutorial will cover how to copy and manipulate data using Arrays to build dynamic reports in Excel.
For this code, we will only use dynamic arrays. Dictionaries can be used to further optimize the code and we will use them in another session.
The main feature of this tutorial is to give the end-user the ability to update the table mappings if the input dataset changes. The changes we will cater to relate to:
- Changes in the column headers of the input dataset.
- Choosing what columns from the input data to copy over, and in what position.
- Changes to additional mappings of values in the dataset.
Our focus here, is to using Dynamic Arrays instead of a traditional For Loop to iterate through a physical range of data. The advantages are a clear increase in processing speed and a whole new world of possibilities for manipulating large datasets.
Basic Copy and Paste
We will cover the traditional way to copy a range of data that mimics a physical copy and paste of data. And, then we will go through copying data by dumping the entire range of data into a dynamic array, and then off-loading the contents of that array into the destination range.
Copying using arrays is far superior in terms of speed.
Sub Copy_Basics() wsOut.Cells.Clear ' Traditional way to copy using range wsIn.Range("A1").CurrentRegion.Copy wsOut.Range("A1") ' Copying using arrays Dim arr As Variant arr = wsIn.Range("A1").CurrentRegion.Value wsOut.Range("A1").Resize(UBound(arr, 1), UBound(arr, 2)).Value = arr End Sub
Advanced Array Manipulation
Our approach is to dump each range of data into a separate array. We have 6 arrays in total. We will follow the below sequence:
- Dump the Input Data Header, Input Data Body, Mapping Data and Product Group Data into separate dynamic arrays.
- Check if the headers in the Input data have changed or not. If they have, we will need to exit the sub as our further mappings will not work.
- Paste the header of the Output data set onto the Output worksheet.
- Transfer the relevant columns from the array containing the Input dataset into the array containing the Output dataset. This transfer will use the logic given in the array containing the mapping dataset.
- We have additional mappings for the group and sub-group of the product. We can obtain these by grabbing the corresponding group and sub-groups in the Group array that relate to each product in the Output .
- Finally, we will dump the contents of the Output array into the Output worksheet.
Sub Array_Advanced() wsOut.Cells.Clear If wsIn.Range("a2").Value = "" Then MsgBox "no data" Exit Sub End If Dim arrIn As Variant, arrOut As Variant, arrMap As Variant, arrGroup As Variant Dim arrInHead As Variant, arrOutHead As Variant Dim lrow As Long, lcol As Long lrow = wsIn.Cells(wsIn.Rows.Count, 1).End(xlUp).Row lcol = wsIn.Cells(1, wsIn.Columns.Count).End(xlToLeft).Column arrInHead = wsIn.Range(wsIn.Cells(1, 1), wsIn.Cells(1, lcol)).Value arrIn = wsIn.Range(wsIn.Cells(2, 1), wsIn.Cells(lrow, lcol)).Value ReDim arrOut(1 To UBound(arrIn, 1), 1 To UBound(arrIn, 2)) lrow = wsGroup.Cells(wsGroup.Rows.Count, 1).End(xlUp).Row lcol = wsGroup.Cells(1, wsGroup.Columns.Count).End(xlToLeft).Column arrGroup = wsGroup.Range(wsGroup.Cells(2, 1), wsGroup.Cells(lrow, lcol)).Value Dim sCell As String sCell = wsMap.Range("A6").End(xlToRight).Address arrOutHead = wsMap.Range("A6:" & sCell).Value arrMap = wsMap.Range("A1").CurrentRegion.Value '1. Check if Column Headings in Data have not changed Dim i As Long For i = LBound(arrInHead, 2) To UBound(arrInHead, 2) If arrInHead(1, i) <> arrMap(1, i) Then MsgBox "Column name mismatch on " & arrInHead(1, i) & " vs " & arrMap(1, i) Exit Sub End If Next i '2. Paste Output Header onto Output Worksheet wsOut.Range(wsOut.Cells(1, 1), wsOut.Cells(1, UBound(arrOutHead, 2))).Value = arrOutHead '3. Transfer data from Input Array to Output Array using position mapping in the Mapping array Dim j As Long Dim sOutHeaderPos As Long For i = LBound(arrIn, 1) To UBound(arrIn, 1) For j = LBound(arrIn, 2) To UBound(arrIn, 2) sOutHeaderPos = arrMap(4, j) If sOutHeaderPos <> 0 Then arrOut(i, sOutHeaderPos) = arrIn(i, j) End If Next j Next i '4. Get the Group and Sub-Group Values Dim outProduct As String, groupProduct As String For i = LBound(arrOut, 1) To UBound(arrOut, 1) outProduct = arrOut(i, 1) For j = LBound(arrGroup, 1) To UBound(arrGroup, 1) groupProduct = arrGroup(j, 1) If outProduct = groupProduct Then arrOut(i, 2) = arrGroup(j, 3) arrOut(i, 3) = arrGroup(j, 2) GoTo LineNext End If Next j arrOut(i, 2) = "Unmapped" arrOut(i, 3) = "Unmapped" LineNext: Next i '5. Dump final array onto Output sheet wsOut.Range(wsOut.Cells(2, 1), wsOut.Cells(UBound(arrOut, 1) + 1, UBound(arrOut, 2))).Value = arrOut End Sub