Adding Values to a dynamic array in vbscript from keys of dictionary object

Viewed 330

I am a beginner to VBScript and new to SO and i am trying to add Keys of a dictionary object to a dynamic array based on certain condition that an array should hold maximum cnt of 100 or less than 100 only.Please find the below code and explanation for more clarity.

Dim dict,dict1,str_nbr,cnt,arrtest2()

str_nbr = "9728"

Set dict = CreateObject("Scripting.Dictionary")
dict.Add "Returns","67"
dict.Add "Debit","59"
dict.Add "PSR_PQV","55"
dict.Add "GiftCard","54"
dict.Add "Sales","45"
dict.Add "Discounts","26"
dict.Add "WIP","25"
dict.Add "Pro","23"
dict.Add "Void","20"
dict.Add "Receipt","15"
dict.Add "Price","12"
dict.Add "Inquiry","6"


dictItems = dict.Items
dictKeys = dict.Keys

ABC =  CreateTestArray(dictItems,arrtest2)

The issue i am facing is with function CreateTestArray().Please find the 2 Functions used Below,

Function CreateTestArray(dictObj,arrTest)
    sum =0 
arrcnt = 0
For i = 0 To ubound(dictObj)
    val = dictObj(i)
    'arrcnt = 0
    Do 
        'arrcnt = 0
        Total = sum + val
        val1 = arrcnt + total
            If (Total<=100) and (val1<=100)Then
                
            ReDim  preserve arrTest(i)
                arrTest(0) = str_nbr
                call AddItem(arrTest,dictKeys(i))
                dict.remove(dictKeys(i))
                arrcnt = val1
                Exit do
            else
                Exit do
            End If
            'arrcnt = val1
    Loop while (arrcnt<=100)
    If arrcnt>95 and arrcnt<=100 Then
        Exit for
    End If
Next
CreateTestArray = arrTest
End Function

'####################################

 'To add value to array
    
Function AddItem(arr, val)
    
        ReDim Preserve arr(UBound(arr) + 1)
        arr(UBound(arr)) = val
        AddItem = arr
       
    End Function

'####################################

The purpose of the function CreateTestArray(dictObj,arrTest) is that it will iterate the Items of the dictionary object and sum with each other till the arrcnt <=100 and add it to a array and remove the added key to avoid duplicates when the function is called next time.For Example in the dictionary provided,if we sum the values of Returns,Discounts,Inquiry(67+26+6 = 99),Then arrcnt = 99 which is less than equal to 100 and more than 95 as per requirement.So i am trying to add the keys(Returns,Discounts,Inquiry) to a dynamic array,having **str_nbr at index '0' as per requirement and adding the keys (Returns,Discounts,Inquiry) subsequently to the same array.The output of the array i receive is like below:

**output:**
ABC(0) - 9728
ABC(1) - Returns
ABC(2) - EMPTY
ABC(3) - EMPTY
ABC(4) - EMPTY
ABC(5) - EMPTY
ABC(6) - Discounts
ABC(7) - EMPTY
ABC(8) - EMPTY
ABC(9) -  EMPTY
ABC(10) - EMPTY
ABC(11) - EMPTY
ABC(12) - Inquiry

Please suggest a way or workaround to avoid the 'Empty' fields in the array without changing the remaining logic,I have tried many approaches to get this right but nothing worked out.My final output should be an array just having (9728,returns,discounts,inquiry) omiting the empty fields.Kindly help me out in acheiving this which will be really helpful to proceed further.Thanks in advance.

2 Answers

The problem line is:

ReDim  preserve arrTest(i)

The array size is being updated unnecessarily.

You need to add str_nbr only once, as the first element.

if i = 0 Then
    ReDim arrTest(0)
    arrTest(0) = str_nbr 
end if

Or move it before the for loop.

To clear the blanks from the array, you can create another array then copy the non-blank entries:

ABC =  CreateTestArray(dictItems,arrtest2)

' get non-blank count
cnt = 0
for x=0 to ubound(ABC)
   if ABC(x) <> "" then 
       cnt = cnt + 1
   end if
next

' create new array
dim arr3()
ReDim arr3(cnt)
i = 0
for x=0 to ubound(ABC)
   if ABC(x) <> "" then 
       arr3(i) = ABC(x)
       i = i + 1
   end if
next

' display new array
s=""
for x=0 to ubound(arr3)
   s = s & arr3(x) & vbcrlf
next

msgbox s

Output

9728
Returns
Discounts
Inquiry
Related