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.
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
Answer：
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.
Answer：
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
