VBA Assigning Array to Range and Writing to Sheet returning all zeros-CodePudding

I am trying to assign an array to a range of values in an Excel sheet. When I do though, even though using debug the array is not all zeros, it returns all zeros. The weird thing is for the dat1 variable it does write to the cells correctly. Though that along with dat2 is an array of strings. Thanks in advance.

Sub Comparor()
Dim dat1() As Variant
Dim dat2() As Variant

dat1() = Sheets("Data1").Range("E1:E10").Value2
dat2() = Sheets("Data2").Range("E1:E10").Value2

Dim iTemp As Integer
iTemp = CInt(UBound(dat1))
Dim NumMatches() As Integer
ReDim NumMatches(iTemp)


Dim iNum As Integer


Dim iCompareInner As Integer 'dat 2 cycler
Dim iCompareOuter As Integer 'dat 1 cycler

For iCompareOuter = 1 To UBound(dat1)
    For iCompareInner = 1 To UBound(dat2)
        If (dat1(iCompareOuter, 1) = dat2(iCompareInner, 1)) Then
            NumMatches(iCompareOuter) = NumMatches(iCompareOuter)   1
        End If
    Next iCompareInner
Next iCompareOuter

Dim test22(10, 1) As Integer
For iNum = 1 To UBound(NumMatches)
    'Debug.Print NumMatches(iNum)
    test22(iNum, 1) = NumMatches(iNum)
    Debug.Print test22(iNum, 1)
Next iNum

Sheets("Info").Range("E1:E10").Value2 = dat1
Sheets("Info").Range("F1:F10").Value2 = test22
Sheets("Info").Range("G1:G10").Value2 = NumMatches

End Sub

CodePudding user response：

This for example

Dim test22(10, 1) As Integer

in the absence of Option Base 1 is the same as

Dim test22(0 to 10, 0 to 1) As Integer

I'd use

Dim test22(1 to 10, 1 to 1) As Integer

if you want to match the arrays you read from the worksheet. Otherwise, dropping those arrays to a range only gives you the first "column" (which are all zeros since you never assigned anything there...)

CodePudding user response：

Count Matches (Dictionary, CountIf, Array (Double-Loop))

All three solutions do the same thing.
Using them with some serious data, e.g. 1K uniques on 100K values (means e.g. 100M iterations in the array version) will reveal the efficiency of each code.
But this is more about 2D one-based (one-column) arrays commonly used with (one-column) ranges.
The code is basic i.e. no blanks or error values are expected and each range has at least 2 cells
(i.e. Data = rg.Value with one cell doesn't work).

Option Explicit


Sub ComparorDictionary()
    
    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Read values (duplicates)
    Dim vws As Worksheet: Set vws = wb.Worksheets("Data2")
    Dim vData() As Variant: vData = vws.Range("E1:E10").Value
    Dim vrCount As Long: vrCount = UBound(vData, 1)
    
    ' Count matches using a dictionary.
    
    Dim vDict As Object: Set vDict = CreateObject("Scripting.Dictionary")
    vDict.CompareMode = vbTextCompare
    
    Dim vr As Long
    
    For vr = 1 To vrCount
        vDict(vData(vr, 1)) = vDict(vData(vr, 1))   1
    Next vr
    
    Erase vData ' values data is counted in the dictionary
    
    ' Read uniques (no duplicates).
    Dim uws As Worksheet: Set uws = wb.Worksheets("Data1")
    Dim uData() As Variant: uData = uws.Range("E1:E10").Value
    Dim urCount As Long: urCount = UBound(uData, 1)
    
    ' Write count.
    
    Dim uMatches() As Long: ReDim uMatches(1 To urCount, 1 To 1)
    
    Dim ur As Long
    
    For ur = 1 To urCount
        If vDict.Exists(uData(ur, 1)) Then
            uMatches(ur, 1) = vDict(uData(ur, 1))
        End If
    Next ur
    
    Set vDict = Nothing ' data is in the unique arrays
    
    ' Write result.
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Info")
    
    dws.Range("E1").Resize(urCount).Value = uData
    dws.Range("F1").Resize(urCount).Value = uMatches
    
End Sub


Sub ComparorCountIf()
    
    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Reference values (duplicates). No array is needed.
    Dim vws As Worksheet: Set vws = wb.Worksheets("Data2")
    Dim vrg As Range: Set vrg = vws.Range("E1:E10")
    
    ' Read uniques (no duplicates).
    Dim uws As Worksheet: Set uws = wb.Worksheets("Data1")
    Dim uData() As Variant: uData = uws.Range("E1:E10").Value
    Dim urCount As Long: urCount = UBound(uData, 1)
    
    ' Count matches and write the count.
    
    Dim uMatches() As Long: ReDim uMatches(1 To urCount, 1 To 1)
    
    Dim ur As Long
    
    For ur = 1 To urCount
        uMatches(ur, 1) = Application.CountIf(vrg, uData(ur, 1))
    Next ur
    
    ' Write result.
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Info")
    
    dws.Range("E1").Resize(urCount).Value = uData
    dws.Range("F1").Resize(urCount).Value = uMatches
    
End Sub


Sub ComparorArray()
    
    ' Reference the workbook ('wb').
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Read values (duplicates).
    Dim vws As Worksheet: Set vws = wb.Worksheets("Data2")
    Dim vData() As Variant: vData = vws.Range("E1:E10").Value
    Dim vrCount As Long: vrCount = UBound(vData, 1)
    
    ' Read uniques (no duplicates).
    Dim uws As Worksheet: Set uws = wb.Worksheets("Data1")
    Dim uData() As Variant: uData = uws.Range("E1:E10").Value
    Dim urCount As Long: urCount = UBound(uData, 1)
    
    ' Count matches and write the count.
    
    Dim uMatches() As Long: ReDim uMatches(1 To urCount, 1 To 1)
    
    Dim vr As Long
    Dim ur As Long
    
    For ur = 1 To urCount
        For vr = 1 To vrCount
            If uData(ur, 1) = vData(vr, 1) Then
                uMatches(ur, 1) = uMatches(ur, 1)   1
            End If
        Next vr
    Next ur
    
    Erase vData ' data is in the unique arrays
    
    ' Write result.
    
    Dim dws As Worksheet: Set dws = wb.Worksheets("Info")
    
    dws.Range("E1").Resize(urCount).Value = uData
    dws.Range("F1").Resize(urCount).Value = uMatches
    
End Sub