The best possible way to populate VBA

Question

I have the following spreadsheet structure.

ID, Storage_name, Name_of_product, Quantity_used, Date_Used

The user gives the start and end date and I have to populate all the quantities used of all the products present in the storage between those start/end dates.

For Example

if the structure is

ID   Storage_name   Name_of_Product    Quantity used    Date_used

 1       st1           pro1                2              11/1/2011
 2       st2           pro2                5              11/2/2011
 1       st1           pro1                3              11/2/2011
 4       st1           pro3                5              11/4/2011

and the user selects st1 as the storage location and 11/01/2011 and 11/04/2011 as start and end date my output should be

ID   Storage_name   Name_of_Product    Quantity used    

1     st1              pro1                 7
4     st1              pro3                 5

I am not using databases (I wish I was). Which is the best way to do this.

I am running three loops first from start to end, second to check the storage_name, third to check the Name_of_product and then updating the quantity_counter but its becoming messy. there should be a better way to do this. I am writing the output to a file.

Thanks P.S I know I do not have to use the column storage_name in the output file. Either ways is fine.

I am doing this

Dim quantity as long 
storageName= selectWarehouse.Value  ' from combo box
quantity = 0

With Worksheets("Reports")
 lastrow = .Range("A1").SpecialCells(xlCellTypeLastCell).row + 1
End With

row = 2
 While (row < lastrow)
  If CStr((Worksheets("Reports").Cells(row, 2))) = storageName Then
    name = CStr((Worksheets("Reports").Cells(row, 3)))
    quantity = quantity + CLng(Worksheets("Reports").Cells(row, 4))
  End If
  row = row + 1
 Wend

I am checking for date in the beginning. That part is fine.

"Which is the best way to do this" - use variant arrays for your data manipulation and then a final dump to your sheet. *Never* run For loops to dump info cell by cell. I cant get to this now, will look over the weekend if possible — brettdj, Dec 02 '11 at 01:38

score 2 · Answer 1 · answered Dec 01 '11 at 23:33

2

You could use a dictionary. Here is some pseudo code that can get you started.

Start
  If range = storageName then
    if within the date range then
        If not dictionary.exists(storageName) then dictionary.add storageName
        dictionary(storageName) =     dictionary(storageName) + quantity
Loop

Now you only have to loop through the cells once.

answered Dec 01 '11 at 23:33

Justin Self

6,137
3
33
48

Dictionary is a good idea.. I didn't know VBA had dictionary support – Ank Dec 01 '11 at 23:36
1

Be sure to Dim as an object then Set = CreateObject("scripting.dictionary") to use. – Gaijinhunter Dec 02 '11 at 00:08
How do I access the value of a key that I have added in a dictionary. I'm trying to do what I do in Python but it isn't working.. key = name or product value = quantity used – Ank Dec 02 '11 at 00:10
Just realized.. I might not be able to use dictionary as the keys are non unique.. There's more than one row having same product name.. – Ank Dec 02 '11 at 00:12
Add a reference to the Microsoft Scripting Runtime. As for Same product name, you are just adding up the totals right? So you are adding to the number thats already stored in the dictionary. – Justin Self Dec 02 '11 at 00:31
You could also use the ID to store as the key. – Justin Self Dec 02 '11 at 00:36
No, you are correct. However, if itemA has 15 and you encounter another ItemA, just add to the current count. – Justin Self Dec 02 '11 at 00:51

score 1 · Accepted Answer · answered Dec 02 '11 at 12:50

You can use SQL with ADO and Excel

Dim cn As Object
Dim rs As Object
Dim strFile As String
Dim strCon As String
Dim strSQL As String
Dim s As String
Dim i As Integer, j As Integer

''This is not the best way to refer to the workbook
''you want, but it is very convenient for notes
''It is probably best to use the name of the workbook.

strFile = ActiveWorkbook.FullName

''Note that if HDR=No, F1,F2 etc are used for column names,
''if HDR=Yes, the names in the first row of the range
''can be used. 
''
''This is the Jet 4 connection string, you can get more
''here : http://www.connectionstrings.com/excel

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile _
    & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"

''Late binding, so no reference is needed

Set cn = CreateObject("ADODB.Connection")
Set rs = CreateObject("ADODB.Recordset")

cn.Open strCon

''Some rough notes on input
sName = [A1]
dteStart = [A2]
dteEnd = [A3]

''Jet / ACE SQL
strSQL = "SELECT ID, Storage_name, Name_of_Product, Sum([Quantity used]) " _
       & "FROM [Report$] a " _
       & "WHERE Storage_name ='" & sName _
       & "' AND Date_Used Between #" & Format(dteStart, "yyyy/mm/dd") _
       & "# And  #" & Format(dteEnd, "yyyy/mm/dd") _
       & "# GROUP BY ID, Storage_name, Name_of_Product"

rs.Open strSQL, cn, 3, 3

''Pick a suitable empty worksheet for the results

Worksheets("Sheet3")
   For i = 0 To rs.Field.Count
       .Cells(1, i+1) = rs.Fields(i).Name
   Next 

   .Cells(2, 1).CopyFromRecordset rs
End With

''Tidy up
rs.Close
Set rs=Nothing
cn.Close
Set cn=Nothing

@Ankur Look at the connection string, it connects to an Excel spreadsheet. You can treat an organised set of data in Excel as a table with ADO. See also http://support.microsoft.com/kb/257819 — Fionnuala, Dec 02 '11 at 21:13

score 0 · Answer 3 · edited May 23 '17 at 11:55

I didn't test the code below but something like this should work for you. Also, I have a reference to the dictionary object but you can late bound it too.

Public Sub FilterTest(ByVal sStorageName As String, ByVal dDate1 As Double, ByVal dDate2 As Double)

    Dim dicItems As Dictionary
    Dim i As Long, lRowEnd As Long, lItem As Long
    Dim rData As Range, rResults As Range
    Dim saResults() As String
    Dim vData As Variant
    Dim wks As Worksheet, wksTarget As Worksheet

    'Get worksheet object, last row in column A, data
    Set wksTarget = Worksheets("Target")
    Set wks = Worksheets("Reports")
    lRowEnd = wks.Range(Rows.Count).End(xlUp).Row
    Set rData = wks.Range(wks.Cells(1, 1), wks.Cells(lRowEnd, ColumnNames.ColumnEnd))
    'Place data in 2D array
    vData = rData

    'Loop through data and gather correct data in dictionary
    Set dicItems = New Dictionary
    ReDim saResults(1 To 10, 1 To 4)
    For i = 1 To lRowEnd
        If vData(i, ColumnNames.Storage_name + 1) = sStorageName Then
            If vData(i, ColumnNames.Date_used + 1) >= dDate1 And vData(i, ColumnNames.Date_used + 1) <= dDate2 Then
                If dicItems.Exists(vData(i, ColumnNames.Name_of_Product + 1)) Then
                    'Determin location in array
                    lItem = dicItems(vData(i, ColumnNames.Name_of_Product + 1))
                    'Add new value to array
                    saResults(dicItems.Count + 1, 4) = CStr(CDbl(saResults(dicItems.Count + 1, 4)) + CDbl(vData(i, ColumnNames.Quantity_used + 1)))
                Else
                    'If new add new item to results string array
                    saResults(dicItems.Count + 1, 1) = CStr(vData(i, ColumnNames.ID + 1))
                    saResults(dicItems.Count + 1, 2) = CStr(vData(i, ColumnNames.Storage_name + 1))
                    saResults(dicItems.Count + 1, 3) = CStr(vData(i, ColumnNames.Name_of_Product + 1))
                    saResults(dicItems.Count + 1, 4) = CStr(vData(i, ColumnNames.Quantity_used + 1))
                    'Add location in array
                    dicItems.Add vData(i, ColumnNames.Name_of_Product + 1), dicItems.Count + 1
                End If
            End If
        End If
    Next i
    ReDim Preserve saResults(1 To dicItems.Count, 1 To 4)

    'Print Results to target worksheet
    With wksTarget
        Set rResults = .Range(.Cells(1, 1), .Cells(dicItems.Count, 4))
        rResults = saResults
    End With

End Sub

The best possible way to populate VBA

3 Answers3