Assign existing values of VBA array to new array

The UDF should be used as array formula.

• Select a range which has 3 columns (eg. F1:H8)
• Input formula =sortingArray(A1:D20), press Ctrl+Shift+Enter

Option Explicit
Function sortingArray(rngData As Variant) As Variant
    Dim objDicInve As Object, objDicSold As Object
    Dim i As Long, sKey, sType As String
    Dim arrData, arrRes
    If TypeName(rngData) = "Range" Then
        If rngData.Columns.Count <> 4 Then Exit Function
        Set objDicInve = CreateObject("scripting.dictionary")
        Set objDicSold = CreateObject("scripting.dictionary")
        arrData = rngData.Value
        For i = LBound(arrData) To UBound(arrData)
            sKey = arrData(i, 3)
            If Not objDicInve.exists(sKey) Then
                objDicInve(sKey) = 0
                objDicSold(sKey) = 0
            End If
            sType = Split(arrData(i, 2), "_")(0)
            If StrComp(sType, "Inventory", vbTextCompare) = 0 Then
                objDicInve(sKey) = objDicInve(sKey) + arrData(i, 4)
            ElseIf StrComp(sType, "Sold", vbTextCompare) = 0 Then
                objDicSold(sKey) = objDicSold(sKey) + arrData(i, 4)
            End If
        Next i
        ReDim arrRes(objDicInve.Count, 2)
        arrRes(0, 0) = "Group Code"
        arrRes(0, 1) = "Inventory"
        arrRes(0, 2) = "Sold"
        i = 0
        For Each sKey In objDicInve.Keys
            i = i + 1
            arrRes(i, 0) = sKey
            arrRes(i, 1) = objDicInve(sKey)
            arrRes(i, 2) = objDicSold(sKey)
        Next
        sortingArray = arrRes
    End If
End Function

Update: Use array parameter

Function sortingArray2(arrData As Variant) As Variant
    Dim objDicInve As Object, objDicSold As Object
    Dim i As Long, sKey, sType As String, arrRes
    If TypeName(arrData) = "Array" Then
        If UBound(arrData, 2) < 4 Then Exit Function
        Set objDicInve = CreateObject("scripting.dictionary")
        Set objDicSold = CreateObject("scripting.dictionary")
        For i = LBound(arrData) To UBound(arrData)
        ' ...
        ' this part is same as sortingArray()
        ' ...
        sortingArray = arrRes
    End If
End Function

If I were you, I prefer to have a pivot table.

• Add a helper column (Col5). The formula is =LEFT([@Col2],SEARCH("_",[@Col2])-1).
• Create a pivot table as below.

• It is a demo how to use Redim based on OP's code logic. It haven't archieve the final goal.

Function sortingArray(rng As Variant)
    Dim counter As Integer
    Dim i As Long, j As Variant, z As Variant
    Dim inventory() As Variant, arr
    Dim soldItems As Variant
    counter = 0
    arr = rng.Value
    For i = LBound(arr) To UBound(arr)
        If InStr(arr(i, 2), "Inventory") Then
            j = arr(i, 3)
            z = arr(i, 4)
            ReDim Preserve inventory(1, counter)
            inventory(0, counter) = j
            inventory(1, counter) = z
            counter = counter + 1
        End If
    Next i
    sortingArray = Application.Transpose(inventory)
End Function

This you can reach with formulas. Lets assume that the results are in columns H:J

Formula in H1: =UNIQUE(C1:C20,FALSE)

Formula in I1: =SUM((D$1:D$20)*NOT(ISERR(SEARCH("Inventory",B$1:B$20)>0))*(C$1:C$20=H1))

Formula in J1: =SUM((D$1:D$20)*NOT(ISERR(SEARCH("Sold",B$1:B$20)>0))*(C$1:C$20=H1))

Result

Sum Up Unique By Criteria (Pivot!?)

A Common Scenario (Usage)

Sub Test()

    Dim sData() As Variant, dData() As Variant
    
    With Sheet1
        With .Range("A1").CurrentRegion
            sData = .Resize(.Rows.Count - 1).Offset(1).Value ' exclude headers
        End With
        dData = GetSumsByCriteria(sData, Array("Inventory*", "Sold*"), 3, 2, 4)
        With .Range("F2").Resize(UBound(dData, 1), UBound(dData, 2))
            .Value = dData
        End With
    End With

    ' Or e.g.: 
    PrintData dData

End Sub

The Function

Function GetSumsByCriteria( _
    ByVal SourceData As Variant, _
    ByVal CriteriaArray As Variant, _
    ByVal GroupColumn As Long, _
    ByVal CriteriaColumn As Long, _
    ByVal SumupColumn As Long) _
As Variant

    Dim cLB As Long: cLB = LBound(CriteriaArray)
    Dim cUB As Long: cUB = UBound(CriteriaArray)
    Dim cArr() As Double: ReDim cArr(cLB To cUB)
        
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim grVal As Variant, crVal As Variant, srval As Variant
    Dim sr As Long, c As Long
    
    For sr = 1 To UBound(SourceData, 1)
        grVal = SourceData(sr, GroupColumn) ' group
        If Not IsError(grVal) Then
            If Not dict.Exists(grVal) Then dict(grVal) = cArr
            crVal = SourceData(sr, CriteriaColumn) ' criteria
            If Not IsError(crVal) Then
                srval = SourceData(sr, SumupColumn) ' sum-up
                If VarType(srval) = vbDouble Then
                    For c = cLB To cUB
                        If crVal Like CriteriaArray(c) Then
                            SumDictArr dict, grVal, c, srval
                            ' This doesn't work!
                            'dict(grVal)(c) = dict(grVal)(c) + srval
                            Exit For
                        End If
                    Next c
                End If
            End If
        End If
    Next sr
    
    Dim dData() As Variant: ReDim dData(1 To dict.Count, 1 To cUB - cLB + 2)
    
    Dim dr As Long, dc As Long
    
    For Each grVal In dict.Keys
        dr = dr + 1
        dData(dr, 1) = grVal
        dc = 1
        For c = cLB To cUB
            dc = dc + 1
            dData(dr, dc) = dict(grVal)(c)
        Next c
    Next grVal
        
    GetSumsByCriteria = dData

End Function

Function Help

Sub SumDictArr( _
        ByRef dict As Object, _
        ByVal Key As Variant, _
        ByVal Index As Long, _
        ByVal Number As Double)
    Dim Arr() As Double: Arr = dict(Key)
    Arr(Index) = Arr(Index) + Number
    dict(Key) = Arr
End Sub

Print Data Result

• You can find the PrintData procedure here.

PrintData Result
     A1    5.768  14.07
    4/z 10.72841 34.848
  b24-0   1.5799  46.08
     V3    6.979  13.45
     L2        0 10.675
  KP/09    18.99  23.98
78-ir-8        0 0.0672

My proposal would be to use a dictionary and a simple class for the values

The simple class I named pData looks like that

Option Explicit

Public soldValue As Double
Public inventoryValue As Double

The following function takes the input from a range which looks like your posted data (no headers, but 4 columns though the first column seems to be superfluous) and returns an array with the dimensions (number of rows,4).

Function getExampledata() As Variant

    Dim rg As Range
    Set rg = Range("A1").CurrentRegion
    getExampledata = rg.value

End Function

The array returned from the function above will be the input for the main code in my case but you can replace that with your array as long as this array looks like it should be, see above.

Option Explicit

Const SOLD = "Sold"
Const INVENTORY = "Inventory"
Const DELIMITER = ":"
Sub main()

    Dim vdata As Variant
    'Here you have to use your own code resp. Array
    'Assumption is you have 4 columns like written in your post
    'and the order is like in your post
    vdata = getExampledata
    
    Dim dict As Scripting.Dictionary
    Set dict = New Scripting.Dictionary
    
    Dim groupCode As String ' Name of the 3rd column with entries A1, 4/5,...
    Dim amount As Double    ' Value in the last column
    Dim category As String  ' Inventory or Sold
        
    Dim itemData As pData, myKey As String
    Dim i As Long
    For i = LBound(vdata, 1) To UBound(vdata, 1)
    
        groupCode = vdata(i, 3)
        amount = CDbl(vdata(i, 4))
        category = grepCategory(vdata(i, 2))
        myKey = Trim(groupCode)
                
        If dict.Exists(myKey) Then
            ' In case the groucode already exists do the math
            ' and add to the corresponding category (Sold or Inventory)
            If category = SOLD Then
                dict.Item(myKey).soldValue = dict.Item(myKey).soldValue + amount
            Else
                dict.Item(myKey).inventoryValue = dict.Item(myKey).inventoryValue + amount
            End If
        Else
            ' Create a new item for pData which contains the amounts for inventory and sold
            Set itemData = New pData
            If category = SOLD Then
                itemData.soldValue = amount
            Else
                itemData.inventoryValue = amount
            End If
            dict.Add groupCode, itemData
        End If
        
    Next i
    
    ' output into array
    Dim rData As Variant, key As Variant
    ReDim rData(1 To dict.Count, 1 To 3)
    i = 1
    
    For Each key In dict
        rData(i, 1) = key
        rData(i, 2) = dict.Item(key).inventoryValue
        rData(i, 3) = dict.Item(key).soldValue
        i = i + 1
    Next
            
    ' Write output to a sheet, just to check
    Worksheets.Add
    Range("A1") = "GroupCode": Range("B1") = "Inventory": Range("C1") = "Sold"
    Dim rg As Range
    Set rg = Range("A2").Resize(dict.Count, 3)
    rg.value = rData
            
            
End Sub

Function grepCategory(ByVal prodA As String) As String
    ' returns inventory or sold for inputs like
    ' Inventory_ProdA, Inventory_ProdB, Sold_ProdA, Sold_ProdB
    ' Assumption is that the second column is like you poster
    
    Dim result As String
    
    If UCase(Left(prodA, 4)) = UCase(SOLD) Then
        result = SOLD
    Else
        If UCase(Left(prodA, 9)) = UCase(INVENTORY) Then result = INVENTORY
    End If

    grepCategory = result

End Function

That is the output (comma is the regional decimal separator for me)

Essentially my issue is i cannot resize the new array properly to accommodate the values i assign to it.

This is a classic VBA problem. This will sound flippant, but the best solution (if possible) is to know the size of the array ahead of time. Fortunately, that's something we can learn in this situation. I'll leverage this fact in the code:

Private Function Rewrite(arr As Variant) As Variant

    ' How many unique group codes are there?
    On Error Resume Next
    Dim ii As Long, collectionGroupCodes As New Collection
    For ii = LBound(arr, 1) To UBound(arr, 1)
        collectionGroupCodes.Add Item:=arr(ii, 3), Key:=arr(ii, 3)
    Next ii
    On Error GoTo -1
    
    ' Because collections only accept unique keys, the number of items in the collection is
    ' the number of unique codes
    Dim uniqueGroupCodes As Long
    uniqueGroupCodes = collectionGroupCodes.Count
    
    ' Create an array that's the right size - no need to redim more than once
    Dim sortingArray() As Variant
    ReDim sortingArray(1 To uniqueGroupCodes, 1 To 3)
    
    ' Iterate through the group codes
    Dim groupCode As String, jj As Long
    For jj = 1 To uniqueGroupCodes
    
        groupCode = collectionGroupCodes(jj)
    
        ' Add the group code to the array
        sortingArray(jj, 1) = groupCode
        
        ' Iterate through the arr array
        For ii = LBound(arr, 1) To UBound(arr, 1)
                
            ' Ignore any values that aren't for this groupCode
            If arr(ii, 3) <> groupCode Then GoTo NextItem
            
            If InStr(arr(ii, 2), "Inventory") = 1 Then
            
                ' Add the value to the Inventory
                sortingArray(jj, 2) = sortingArray(jj, 2) + arr(ii, 4)
                
            Else
            
                ' Add the value to the Sold
                sortingArray(jj, 3) = sortingArray(jj, 3) + arr(ii, 4)
                
            End If
NextItem:
        Next ii
    
    Next jj
    
    Rewrite = sortingArray

End Function

The first handful of lines in the function use a Collection to store group codes. A Collection will not accept more than one item with the same key, much like a Scripting.Dictionary that some other users have suggested. If you try to pass the same key to a collection, it throws a "Run-time error '457': This key is already associated with an element of this collection". This is why we have the On Error Resume Next line in there. We are expecting some errors in normal operation, but we ignore them. I do not recommend using On Error Resume Next regularly. General catch-all error ignorers are a bad idea. You'll see that we turn off this error-ignoring after the loop is finished with On Error GoTo -1.

At this point, we have a Collection that contains the unique group codes, so we can create an array that's the proper size and only ReDim once.

Now for the part you've already got working: loop through each of your group codes, find all of its "Inventory" and "Sold" items, and sum these values to store in the output array. For the sake of completeness, I've added that to the function as well.

You've been presented many potential solutions to your problem, but this one:

• Is a single function which can be used the way your original was meant to be
• Does not rely on binding extra modules (such as Microsoft Scripting Runtime for Scripting.Dictionary objects)