VBA array and dictionary together are very powerful and can help you building so complex logics. though, property of array and dictionary are quite simple. Dictionary stores unique keys, and array is collection of many variables. but any operation on array is very faster as compare to range. here we have a simplest example of array and dictionary.

Download a working file from here.


Join our VBA Training to learn more

Sub FilterAndCreateTabs()
    Dim varData
    Dim varUnique
    Dim varRows
    Dim varResult
    Dim lngIndex As Long
    Dim lngR As Long
    Dim lngC As Long
    Dim varKeys
    Dim varHeaders
    Dim objDic As Object
    Dim wksSheet As Worksheet
    Dim strKey As String
    Dim lngSheetConter As Long
    On Error GoTo Err:
    Application.ScreenUpdating = False
    '--get data into array
    '--Use value2 of range in case of large data.
    varData = Sheet1.Range("rngRange").CurrentRegion.Value2
    varHeaders = Sheet1.Range("rngRange").CurrentRegion.Rows(1)
    '--Create a dictionary object
    Set objDic = CreateObject("Scripting.Dictionary")
    '--Get Uniuqe keys in key and contact row numbers in item.
    For lngR = LBound(varData) + 1 To UBound(varData)
        strKey = varData(lngR, 1)
        objDic.Item(strKey) = objDic.Item(strKey) & "|" & lngR
    Next lngR
    '--Get Unique key from dictionary into an array.
    varKeys = objDic.keys
    For lngSheetConter = LBound(varKeys) To UBound(varKeys)
        varRows = objDic.Item(varKeys(lngSheetConter))
        If varRows <> "" Then
            varRows = Right(varRows, Len(varRows) - 1)
            varRows = Split(varRows, "|")
        End If
        '--Create a blank array to fill the filtered data.
        ReDim varResult(1 To UBound(varRows) + 1, 1 To UBound(varData))
        lngIndex = 1
        For lngR = LBound(varRows) To UBound(varRows)
            For lngC = LBound(varData) To UBound(varData, 2)
                varResult(lngIndex, lngC) = varData(varRows(lngR), lngC)
            Next lngC
            lngIndex = lngIndex + 1
        Next lngR
        If IsSheetAvailable(CStr(varKeys(lngSheetConter))) Then
            Set wksSheet = ThisWorkbook.Worksheets(varKeys(lngSheetConter))
            Set wksSheet = ThisWorkbook.Worksheets.Add(after:=Sheet1)
            wksSheet.Name = varKeys(lngSheetConter)
        End If
        wksSheet.Range("A2").Resize(lngIndex - 1, UBound(varData, 2)).Value = varResult
        wksSheet.Range("A1").Resize(1, UBound(varData, 2)).Value = varHeaders
        wksSheet.Range("A1").Resize(1, UBound(varData, 2)).Interior.Color = Sheet1.Range("rngRange").Interior.Color
    Next lngSheetConter
    MsgBox "Done", vbInformation
Application.ScreenUpdating = True
If Err.Number <> 0 Then MsgBox Err.Description
End Sub

Function IsSheetAvailable(strSheetName As String) As Boolean
    Dim wksSheet As Worksheet
    For Each wksSheet In ThisWorkbook.Worksheets
        If wksSheet.Name = strSheetName Then
            IsSheetAvailable = True
            Exit Function
        End If
    Next wksSheet
End Function

Click here to add your own text

Join our VBA Training to learn more