# Array - Sales report

Hi Experts

Can someone please help with  \sales values being carried over to the next month\.

I had a function that calculated total sales, shown by month , by rep
I now want to calculate just the sales that our letters are generating (in a 40day period after the letter), also shown by month by rep.

Essentially what I have done is place a loop around the original (totalsales) report thereby limiting the original section to calculate sales per individual letter within it's 40day period. It's doing that very nicely on a letter by letter basis, but I'm having trouble stacking all the letter's sales reports onto each other.  As it stands here only the lowest month (eg -2) is correct. Thereafter every month starts off with the previous months value and adds to it.
Is there a way to stop the prev months total getting carried over, (without deleting whatever may already exist in that next months array )
eg
Mnth    Rep1   Rep2..........
-2         \$54       \$100
-1         \$54       \$150
0            \$54       \$ 150

Mnth    Rep1   Rep2..........
-2         \$54       \$100
-1         \$0         \$50
0            \$0       \$ 0

A long bit of code, but I'm just asking for a general guide. Many thanks

Peter (will check in in a couple of hours and then tomorrow morn)
``````Dim SalesRpt As Recordset 'sum of sales fees by month , by rep
Dim Letters As Recordset 'All letters + date written
'
Dim MthNos As Integer
Dim Rep1 As Single
Dim Rep2 As Single
Dim Rep3 As Single
Dim Rep4 As Single
Dim RepOther As Single
'
'
Dim X As Integer
Dim Y As Integer
'
Dim ClientId As Integer
Dim Fromdate As String ' date letter was written
Dim Todate As String    'until 40 days after last letter was written

'clear salesrpt
For X = 1 To UBound(SalesRpt, 1)
For Y = 1 To UBound(SalesRpt, 2)
SalesRpt(X, Y) = ""
Next
Next

'
'select LETTERS records
Set Letters = CURDB.OpenRecordset("Select * from LETTERS where Isdate(PC_Letterdate) = true order by (PC_Letterdate) asc", dbOpenDynaset)
Letters.MoveFirst

'********************************************************************
'Loop through Letters & calculate sales within 40 days of each correspondence
'********************************************************************

Do While Not Letters.EOF
'ClientId
ClientId = Letters("PC_ClientID")
'Fromdate
Fromdate = Letters("PC_LetterDate")
'ToDate - + 40 days
Todate = DateAdd("d", 40, Fromdate)

'****original report  (total sales , by month , by rep )******
'Adapted to only select sales to a client within 40days of a letter (ie fromdate and todate)
SQL = ""
SQL = "Select Year([SH_ServDate]) as Yr, Month([SH_ServDate]) as Mth, [SH_RepID] as Doctor"
SQL = SQL & ", first(DateDiff('m', Now, [SH_ServDate])) as MthNr"
SQL = SQL & ", Sum([SH_Fee]) as SalesFee"
SQL = SQL & " from SALES_HISTORY inner join LETTERS"
SQL = SQL & " on SALES_HISTORY.[SH_ClientId] = LETTERS.[PC_ClientID]"
SQL = SQL & " where [SH_ServDate] > datevalue('" & Fromdate & "')"
SQL = SQL & " and [SH_ServDate] < datevalue('" & Todate & "')"
SQL = SQL & " and [SH_ClientId] = " & ClientId
SQL = SQL & " and [SH_ItemNos] in ('21','23','53','54','721','723','725','2620','2517','10991','10993','10990')"
SQL = SQL & " group by Year([SH_ServDate]), Month([SH_ServDate]), SH_RepID"
SQL = SQL & " order by Year([SH_ServDate]), Month([SH_ServDate]), SH_RepID"
':
Set SalesRpt = CURDB.OpenRecordset(SQL, dbOpenSnapshot)
DoEvents
'
On Error Resume Next
SalesRpt.MoveLast

If SalesRpt.RecordCount = 0 Then
'move to next letter
Else
SalesRpt.MoveFirst
End If

MthNos = SalesRpt("MthNr")

'place sales generated by this letter into array. Arranged (by rep, by month)
Do

If MthNos = SalesRpt("MthNr") Then

If InStr(1, UCase\$(SalesRpt("Rep")), "REP1") > 0 Then
Rep1 = Rep1 + SalesRpt("SalesFee")

ElseIf InStr(1, UCase\$(SalesRpt("Rep")), "REP2") > 0 Then
Rep2 = Rep2 + SalesRpt("SalesFee")

ElseIf InStr(1, UCase\$(SalesRpt("Rep")), "REP3") > 0 Then
Rep3 = Rep3 + SalesRpt("SalesFee")

ElseIf InStr(1, UCase\$(SalesRpt("Rep")), "REP4") > 0 Then
Rep4 = Rep4 + SalesRpt("SalesFee")

Else
RepOther = RepOther + SalesRpt("SalesFee")

End If
'
End If
'
'keep/print previous months totals in array
SalesRpt((MthNos + 25), 1) = CStr(Format(Rep1, "Currency"))
SalesRpt((MthNos + 25), 2) = CStr(Format(Rep2, "Currency"))
SalesRpt((MthNos + 25), 3) = CStr(Format(Rep3, "Currency"))
SalesRpt((MthNos + 25), 4) = CStr(Format(Rep4, "Currency"))
SalesRpt((MthNos + 25), 5) = CStr(Format(RepOther, "Currency"))

'print on screen
IMPList.AddItem MthNos & vbTab _
& CStr(Format(Rep1, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep2, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep3, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep4, "Currency")) & vbTab & vbTab _
& CStr(Format(RepOther, "Currency"))

'reset totals for new month
MthNos = SalesRpt("MthNr")
Rep1 = 0
Rep2 = 0
Rep3 = 0
Rep4 = 0
RepOther = 0
Extra40 = 0

'add sales to existing array
If MthNos = SalesRpt("MthNr") Then

If InStr(1, UCase\$(SalesRpt("Rep")), "REP1") > 0 Then
Rep1 = Rep1 + SalesRpt("SalesFee")

ElseIf InStr(1, UCase\$(SalesRpt("Rep")), "REP2") > 0 Then
Rep2 = Rep2 + SalesRpt("SalesFee")

ElseIf InStr(1, UCase\$(SalesRpt("Rep")), "REP3") > 0 Then
Rep3 = Rep3 + SalesRpt("SalesFee")

ElseIf InStr(1, UCase\$(SalesRpt("Rep")), "REP4") > 0 Then
Rep4 = Rep4 + SalesRpt("SalesFee")

Else
RepOther = RepOther + SalesRpt("SalesFee")

End If
End If

SalesRpt.MoveNext
'
Loop Until SalesRpt.EOF 'gets sales totals by month for current letter

'keep totals in array
SalesRpt((MthNos + 25), 1) = CStr(Format(Rep1, "Currency"))
SalesRpt((MthNos + 25), 2) = CStr(Format(Rep2, "Currency"))
SalesRpt((MthNos + 25), 3) = CStr(Format(Rep3, "Currency"))
SalesRpt((MthNos + 25), 4) = CStr(Format(Rep4, "Currency"))
SalesRpt((MthNos + 25), 5) = CStr(Format(RepOther, "Currency"))

'print on screen
IMPList.AddItem MthNos & vbTab _
& CStr(Format(Rep1, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep2, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep3, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep4, "Currency")) & vbTab & vbTab _
& CStr(Format(RepOther, "Currency"))

Letters.MoveNext
Loop 'moves to next letter

SalesRpt.Close
DoEvents
``````
Visual Basic Classic

Last Comment
peterdarazs
GrahamSkan

Is SalesRpt a Recordset or an Array?
peterdarazs

I'm sorry , that should read Dim SSRpt As Recordset
SalesRpt is the array.

Some names were changed for illustrative purposes and I accidentally named then the same. (whats the chances??) Anyway,  I'm just wondering whether this task requires a 3 dimensional array to "stack" the SalesRpt records and then add up each months totals or is there an easier way of  adjusting the routine in it's present form to give the same results.

Many thanks.

Peter

``````Dim SSRpt As Recordset 'sum of sales fees by month , by rep
Dim Letters As Recordset 'All letters + date written
'
Dim MthNos As Integer
Dim Rep1 As Single
Dim Rep2 As Single
Dim Rep3 As Single
Dim Rep4 As Single
Dim RepOther As Single
'
'
Dim X As Integer
Dim Y As Integer
'
Dim ClientId As Integer
Dim Fromdate As String ' date letter was written
Dim Todate As String    'until 40 days after last letter was written

'clear salesrpt
For X = 1 To UBound(SSRpt, 1)
For Y = 1 To UBound(SSRpt, 2)
SalesRpt(X, Y) = ""
Next
Next

'
'select LETTERS records
Set Letters = CURDB.OpenRecordset("Select * from LETTERS where Isdate(PC_Letterdate) = true order by (PC_Letterdate) asc", dbOpenDynaset)
Letters.MoveFirst

'********************************************************************
'Loop through Letters & calculate sales within 40 days of each letter
'********************************************************************

Do While Not Letters.EOF
'ClientId
ClientId = Letters("PC_ClientID")
'Fromdate
Fromdate = Letters("PC_LetterDate")
'ToDate - + 40 days
Todate = DateAdd("d", 40, Fromdate)

'****original report  (total sales , by month , by rep )******
'Adapted to only select sales to a client within 40days of a letter (ie fromdate and todate)
SQL = ""
SQL = "Select Year([SH_ServDate]) as Yr, Month([SH_ServDate]) as Mth, [SH_RepID] as Doctor"
SQL = SQL & ", first(DateDiff('m', Now, [SH_ServDate])) as MthNr"
SQL = SQL & ", Sum([SH_Fee]) as SalesFee"
SQL = SQL & " from SALES_HISTORY inner join LETTERS"
SQL = SQL & " on SALES_HISTORY.[SH_ClientId] = LETTERS.[PC_ClientID]"
SQL = SQL & " where [SH_ServDate] > datevalue('" & Fromdate & "')"
SQL = SQL & " and [SH_ServDate] < datevalue('" & Todate & "')"
SQL = SQL & " and [SH_ClientId] = " & ClientId
SQL = SQL & " and [SH_ItemNos] in ('21','23','53','54','721','723','725','2620','2517','10991','10993','10990')"
SQL = SQL & " group by Year([SH_ServDate]), Month([SH_ServDate]), SH_RepID"
SQL = SQL & " order by Year([SH_ServDate]), Month([SH_ServDate]), SH_RepID"
':
Set SSRpt = CURDB.OpenRecordset(SQL, dbOpenSnapshot)
DoEvents
'
On Error Resume Next
SSRpt.MoveLast

If SSRpt.RecordCount = 0 Then
'move to next letter
Else
SSRpt.MoveFirst
End If

MthNos = SSRpt("MthNr")

'place sales generated by this letter into array. Arranged (by rep, by month)
Do

If MthNos = SSRpt("MthNr") Then

If InStr(1, UCase\$(SSRpt("Rep")), "REP1") > 0 Then
Rep1 = Rep1 + SSRpt("SalesFee")

ElseIf InStr(1, UCase\$(SSRpt("Rep")), "REP2") > 0 Then
Rep2 = Rep2 + SSRpt("SalesFee")

ElseIf InStr(1, UCase\$(SSRpt("Rep")), "REP3") > 0 Then
Rep3 = Rep3 + SSRpt("SalesFee")

ElseIf InStr(1, UCase\$(SSRpt("Rep")), "REP4") > 0 Then
Rep4 = Rep4 + SSRpt("SalesFee")

Else
RepOther = RepOther + SSRpt("SalesFee")

End If
'
End If
'
'keep/print previous months totals in array
SalesRpt((MthNos + 25), 1) = CStr(Format(Rep1, "Currency"))
SalesRpt((MthNos + 25), 2) = CStr(Format(Rep2, "Currency"))
SalesRpt((MthNos + 25), 3) = CStr(Format(Rep3, "Currency"))
SalesRpt((MthNos + 25), 4) = CStr(Format(Rep4, "Currency"))
SalesRpt((MthNos + 25), 5) = CStr(Format(RepOther, "Currency"))

'print on screen
IMPList.AddItem MthNos & vbTab _
& CStr(Format(Rep1, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep2, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep3, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep4, "Currency")) & vbTab & vbTab _
& CStr(Format(RepOther, "Currency"))

'reset totals for new month
MthNos = SalesRpt("MthNr")
Rep1 = 0
Rep2 = 0
Rep3 = 0
Rep4 = 0
RepOther = 0
Extra40 = 0

'add sales to existing array
If MthNos = SSRpt("MthNr") Then

If InStr(1, UCase\$(SSRpt("Rep")), "REP1") > 0 Then
Rep1 = Rep1 + SSRpt("SalesFee")

ElseIf InStr(1, UCase\$(SSRpt("Rep")), "REP2") > 0 Then
Rep2 = Rep2 + SSRpt("SalesFee")

ElseIf InStr(1, UCase\$(SSRpt("Rep")), "REP3") > 0 Then
Rep3 = Rep3 + SSRpt("SalesFee")

ElseIf InStr(1, UCase\$(SSRpt("Rep")), "REP4") > 0 Then
Rep4 = Rep4 + SSRpt("SalesFee")

Else
RepOther = RepOther + SSRpt("SalesFee")

End If
End If

SSRpt.MoveNext
'
Loop Until SSRpt.EOF 'gets sales totals by month for current letter

'keep totals in array
SalesRpt((MthNos + 25), 1) = CStr(Format(Rep1, "Currency"))
SalesRpt((MthNos + 25), 2) = CStr(Format(Rep2, "Currency"))
SalesRpt((MthNos + 25), 3) = CStr(Format(Rep3, "Currency"))
SalesRpt((MthNos + 25), 4) = CStr(Format(Rep4, "Currency"))
SalesRpt((MthNos + 25), 5) = CStr(Format(RepOther, "Currency"))

'print on screen
IMPList.AddItem MthNos & vbTab _
& CStr(Format(Rep1, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep2, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep3, "Currency")) & vbTab & vbTab _
& CStr(Format(Rep4, "Currency")) & vbTab & vbTab _
& CStr(Format(RepOther, "Currency"))

Letters.MoveNext
Loop 'moves to next letter

SSRpt.Close
DoEvents
``````
GrahamSkan

THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
peterdarazs

Probably best to assume it only handles 2 dimensions. I'll try add a 3rd  and post question later if I get stuck. Not to worry ,  thats cleared a lot up.

Many thanks

Peter
Visual Basic Classic

Visual Basic is Microsoft’s event-driven programming language and integrated development environment (IDE) for its Component Object Model (COM) programming model. It is relatively easy to learn and use because of its graphical development features and BASIC heritage. It has been replaced with VB.NET, and is very similar to VBA (Visual Basic for Applications), the programming language for the Microsoft Office product line.

165K
Questions
--
Followers
--
Top Experts
Get a personalized solution from industry experts

TRUSTED BY