I have an array of values result that I got from a REST API call. result = [1,2,3,4,5]

In the beginning

I want to input each value in the array result to populate cells from A1 to A5 (the range is dynamic, based on the number of values in the array, so might not be A5 all the time).

So, if the range (A1-A100) is empty, we populate the cells normally.

As the result array grows

Since the result will increase as we run the Macro again, for example, 15 minutes later the result becomes [1,2,3,4,5,6,7,8]

So, if the range (A1-A5) is not empty, we append the array's additional items at the back of the cell range, if they do not appear in the range (meaning they are additional ones)

I am thinking maybe I should do something like this if the range (A1-A5) is empty:

Given result = [1,2,3,4,5]

'the beginning part' 
i = 1
Set rng = Range(“A1:A5”)

If WorksheetFunction.CountA(Range("A1:A5")) = 0 Then
    For Each cel In rng:
        result(i) = cel.Value
        i = i   1
    Next cel

However, I think there's a major problem in the code & some missing part when array grows, because

1. The number of items in array is uncertain, so shouldn't hardcode value, should make it dynamic
2. When result array grows, I am not sure how to append only the additional items to the back of the cells list, this consist of (1) filtering out items in array that did not appear in the range (2) appending the items in correct positions

Any help would be greatly appreciated, thanks in advance.

CodePudding user response：

Append Unique Values

Usage

Sub AppendUniqueTest()
    
    Dim Arr() As Variant: Arr = Array(1, 2, 3, 4, 5)
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    Dim ws As Worksheet: Set ws = wb.Sheets("Sheet1")
    
    AppendUnique Arr, ws, "A1"

End Sub

The Method

Sub AppendUnique( _
        Arr() As Variant, _
        ByVal ws As Worksheet, _
        ByVal FirstCellAddress As String, _
        Optional ByVal OverWrite As Boolean = False)
   
    ' Write the data from the source range to the source array ('sData').
    ' Reference the first destination cell ('fCell').

    If ws.FilterMode Then ws.ShowAllData
    
    Dim fCell As Range: Set fCell = ws.Range(FirstCellAddress)
    
    Dim sData() As Variant, srCount As Long
    
    With fCell
        Dim lCell As Range: Set lCell = .Resize(ws.Rows.Count - .Row   1) _
            .Find("*", , xlFormulas, , , xlPrevious)
        If Not lCell Is Nothing Then
            srCount = lCell.Row - .Row   1
            If srCount = 1 Then
                ReDim sData(1 To 1, 1 To 1): sData(1, 1) = .Value
            Else
                sData = .Resize(srCount).Value
            End If
            If Not OverWrite Then Set fCell = lCell.Offset(1)
        End If
    End With
            
    ' Write the unique data from the source array to a dictionary.
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim sr As Long
    
    For sr = 1 To srCount: dict(CStr(sData(sr, 1))) = Empty: Next sr
    
    Erase sData
    
    ' Define the destination array ('dData').
    
    Dim lb As Long: lb = LBound(Arr)
    Dim ub As Long: ub = UBound(Arr)
    
    Dim dData() As Variant: ReDim dData(1 To ub - lb   1, 1 To 1)
                 
    ' Check the values from the given array ('Arr') against the values
    ' in the dictionary and write the non-matches to the destination array.
    
    Dim dr As Long, c As Long, cString As String
                 
    For c = lb To ub
        cString = CStr(Arr(c))
        If Len(cString) > 0 Then ' is not blank
            If Not dict.Exists(cString) Then ' is not in the dictionary
                dict(cString) = Empty ' prevent dupes from the given array
                dr = dr   1
                dData(dr, 1) = cString
            End If
        End If
    Next c
    
    If dr = 0 Then
        MsgBox "No new values found.", vbExclamation
        Exit Sub
    End If
    
    ' Write the values from the destination array to the destination range.
    
    fCell.Resize(dr).Value = dData
    If OverWrite Then ' clear below
        fCell.Resize(ws.Rows.Count - fCell.Row - dr   1).Offset(dr).Clear
    End If
        
    ' Inform.
        
    MsgBox "Data appended.", vbInformation
         
End Sub