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.

DictionaryArray

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))
            wksSheet.UsedRange.Clear
        Else
            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
Err:
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