How can I set the range for a horizontal list to be captured in a dictionary-CodePudding

found this helpful code to compare two lists and then extract any missing item from List 1 that is not in List 2.

Issue I have is to set the range for the second since the list is horizontal not vertically structured. the code line "Set rgCompare = Worksheets("Dashboard_Data").Range("B1:b100")" is supposed to capture B1:CF1. When I enter that range, I get everything in List 1 listed as "not in List 2"

Option Explicit

' Description: Use to determine the result type required
Public Enum eResultType
    list1Only = 1
    both = 2
    list2Only = 3
End Enum

' Source worksheet: Data (can be changed in the get ranges section below)
' Destination worksheet: Data (can be changed in the get ranges section below)
Sub MainCompare()

' Set the result type to both or list 1 only
   Dim resultType As eResultType
   resultType = eResultType.list1Only

' Get the ranges
    Dim rgBase As Range, rgCompare As Range, rgResult As Range
    Set rgBase = Worksheets("Ref").Range("Dashboard_Headers")
    Set rgCompare = Worksheets("Dashboard_Data").Range("B1:b100")
    Set rgResult = Worksheets("Error").Range("D1")

' Read the first list to a Dictionary
    Dim dictBase As Dictionary
    Set dictBase = ReadList(rgBase.Value)

' Compare the Dictionary to the second list
    Dim dictResult As Dictionary
    Set dictResult = CompareLists(dictBase, rgCompare.Value, resultType)

' Write out the result
    Call WriteResult(rgResult, dictResult, resultType)

End Sub

' Name: ReadList()
' Description: Reads the first list of data to a dictionary. Note that
' all duplicates are removed.
' Input: array of data taken from the worksheet
' Output: a dictionary of unique values
Public Function ReadList(arr As Variant) As Dictionary

Dim dict As New Dictionary

Dim i As Long
For i = LBound(arr, 1)   1 To UBound(arr, 1)
    dict(arr(i, 1)) = 0
Next i

' Read through the list
    Set ReadList = dict

End Function

' Name: CompareLists()
' Description: Read through a list of data and check if in the dictionary which
' contains the values from the first list
' Input: Dictionary of the first list and array of the second list
' Output: A dictionary of the results

Function CompareLists(dict As Dictionary _
                , arrCompareTo As Variant _
                , Optional resultType As eResultType = eResultType.both) As Dictionary
  
Dim dictBoth As New Dictionary, dictList2 As New Dictionary
    
Dim i As Long, item As Variant
For i = LBound(arrCompareTo) To UBound(arrCompareTo)
    item = arrCompareTo(i, 1)
    If dict.Exists(item) = True Then
        dictBoth(item) = 0
        dict.Remove item
    Else
        dictList2(item) = 0
    End If
Next i

If resultType = both Then
    Set CompareLists = dictBoth
ElseIf resultType = list1Only Then
    Set CompareLists = dict
ElseIf resultType = list2Only Then
    Set CompareLists = dictList2
End If

End Function

' Name: WriteResult()
' Description: Writes out the values from the results dictionary to the worksheet
' Input: Output range, dictionary of data to write, the result type
' Author: Paul Kelly
' https://ExcelMacroMastery.com/
' YouTube video: https://youtu.be/P_UVvYW2xto
Public Sub WriteResult(rg As Range, dict As Dictionary, resultType As eResultType)

' Clear existing data
rg.CurrentRegion.OffSet(1).ClearContents

' Write out list
rg.OffSet(1).Resize(dict.Count, 1).Value = WorksheetFunction.Transpose(dict.Keys)

End Sub

CodePudding user response：

if rgCompare is set to a horizontal range, eg B1:CF1, then change the set dictResult as follows:

Set dictResult = CompareLists(dictBase, Application.Transpose(rgCompare.Value), resultType)

This will switch the array to the orientation the CompareLists function is expecting.