Search and Sum based on selection - excel

Question

I tried Sum, CountIf, Dsum, SumProduct
I have a Userform with a ComboBox "History_Select_Debtor". The RowSource for the ComboBox is "Debtor_list_Debtors" - A Dynamic Named Range on WorkSheet "DebtorList". It consists of Customer Names from A2:A24 but will grow eventually.
The UserForm also Has a Textbox for Total Items Purchased Named "txtPurchased".
With each Transaction a Record is saved on Worksheet "InvoiceList" which consists of 7 Columns.
Each of these Columns have Dynamic Named Ranges
A = "Debtor" (Invoice_list_Debtor)
B = "Item" (Invoice_list_Item)
C = "Price" (Invoice_list_Price)
D = "Date" (Invoice_list_Date)
E = "Time" (Invoice_list_Time)
F = "Balance" (Invoice_list_Balance)
G = "Payed" (InvoiceList_Payed)
The Record Saved in the Item Column is Text;
"Payed Balance","Added Balance","Quarter Item","Half Item","1 Item" - "10 Items"
I need to, "Based on the combo selection (History_Select_Debtor)", Reference that Particilar Debtor with "InvoiceList", sum up the total Number of Purchases and display that Value in "txtPurchased".
I need a specific Value to be assigned to each Item e.g. "Quarter Item" = 0.25 or "5 Item = 5".
If as an example "Adrian" has 7 Transactions recorded on InvoiceList
Added Balance
Quarter Item
Half Item
Quarter Item
10 Items
4 Items
Payed Balance
The Value to be displayed in "txtPurchased" would be "15".
I've a Macro that sums up the total Purchases;
It sums up the Total Row rather than just whichever Debtor is Selected in "History_Select_Debtor"
'-------Total Transactions----------------------------------------------------------------------
Set ws = Worksheets("DebtorList")
With Me
'Starting point of lookup data
Rw = .History_Select_Debtor.ListIndex + 2
History_Select_Debtor.List = Range("Debtor_list_Debtors").Value
txtTransactions.Value = Application.CountIf(Range("Invoice_list_Debtor"), History_Select_Debtor)
End With
'-----------------------------------------------------------------------------------------------
Another Macro I've made which also won't work;
=SUM(IF(Invoice_list_Item="Quarter Item",0.25,0)+IF(Invoice_list_Item="Half Item",0.5,0)+IF(Invoice_list_Item="1 Item",1,0)+IF(Invoice_list_Item="2 Items",2,0)+IF(Invoice_list_Item="3 Items",3,0)+IF(Invoice_list_Item="4 Items",4,0)+IF(Invoice_list_Item="5 Items",5,0)+IF(Invoice_list_Item="10 Items",10,0))
The Issue with this one is that given I use the Invoice_list_Debtor as the RowSource for my ComboBox I end up with over 170 duplicate Names.
Here is the Source Code to the Page I need to code to work on;
Public ListTable As Long
Private Sub UserForm_Initialize()
History_Select_Debtor.List = Range("Debtor_list_Debtors").Value
History_Select_Debtor = ""
Label6.Visible = False
Label7.Visible = False
Label8.Visible = False
Label9.Visible = False
Label10.Visible = False
Label11.Visible = False
Label12.Visible = False
Dim ws As Worksheet
Set ws = Worksheets("InvoiceList")
ListTable = ws.Range("A65536").End(xlUp).Row
Me.ListBox1.List = Range("A2:G" & ListTable).Value
Me.ListBox1.Clear
Me.ListBox1.ColumnWidths = "50;80;70;100;80;80;80"
'-----------Listview--------------------------------------------------------------------------------------------------------------
'Dim ws As Worksheet
'Dim lngRow As Long
'Dim lvwItem As ListItem
'Dim lngEndCol As Long
'Dim lngCol As Long
'Dim lngEndRow As Long
'Dim lngItemIndex As Long
'Dim blnHeaders() As Boolean
'Dim Rw As Long
'Set ws = Worksheets("InvoiceList")
'lngEndCol = ws.Range("A1").End(xlToRight).Column
'lngEndRow = ws.Range("A1").End(xlDown).Row
'ListView1.Gridlines = True
'lngRow = 1
'With ListView1
'.View = lvwReport
'For lngCol = 1 To lngEndCol
'.ColumnHeaders.Add , , ws.Cells(lngRow, lngCol).Text, ws.Columns(lngCol).ColumnWidth + 59.6
'.BackColor = vbBlack
'Next
'For lngRow = 2 To lngEndRow
'lngCol = 1
'lngItemIndex = 0
'Set lvwItem = .ListItems.Add(, , (ws.Cells(lngRow, lngCol).Text))
'For lngCol = 2 To lngEndCol
'lngItemIndex = lngItemIndex + 1
'lvwItem.SubItems(lngItemIndex) = Format(ws.Cells(lngRow, lngCol).Text, ws.Cells(lngRow, lngCol).NumberFormat) 'Adds Value from Current Row and Column 1
'Next
'Next
'.TextBackground = lvwTransparent
'End With
'-----------Listview--------------------------------------------------------------------------------------------------------------
'-----------ChartSpace---------------------------------------------------
Dim ChtSpc As OWC11.ChartSpace
Dim cht As OWC11.ChChart
Dim Sps As OWC11.Spreadsheet
Dim owcChart As OWC11.ChartSpace
Dim Balance As String
Balance = Range("B1").Value
Set owcChart = Me.ChartSpace1
Set ChtSpc = Me.ChartSpace1
Set Sps = Me.Spreadsheet1
Set ws = ThisWorkbook.Worksheets("DebtorList") ' change to you worksheet name
Sps.Range("A1:B100") = ws.Range("A1:B100").Value ' Set worksheet range to sheet control range
Set ChtSpc.DataSource = Sps ' set sheet control as chart control source
Set cht = ChtSpc.Charts.Add ' Add blank chart
With cht ' Set data for chart
.SetData chDimCategories, 0, "A2:A25" ' change to your category range
.SeriesCollection(0).SetData chDimValues, 0, "B2:B25" ' change to your series 1 range
'.PlotArea.FlipHorizontal
'.PlotArea.FlipVertical
'.PlotArea.RotateClockwise
'.SeriesCollection.Add
'.SeriesCollection(1).SetData chDimValues, 0, "A1:A24" ' change to your series 2 range
'By changing the layout we can control how the charts are presented
'inside the Chart space.
.Interior.Color = RGB(0, 0, 0)
.Border.Color = vbWhite
.Border.Weight = Thick
'.Type = chChartTypeColumn3D
'.Type = chChartTypeAreaStacked
End With
Me.Spreadsheet1.Visible = False ' hide the sheet control
'Set up the charts and manipulate some of their properties.
With owcChart.Charts(0)
'The data reference must be of the datatype string.
'The last parameter specify if each row represent a serie or not.
'.HasTitle = True
With .PlotArea
.Interior.Color = RGB(0, 0, 0)
'.Border.Color = RGB(255, 255, 255)
'.Border.DashStyle = chLineSolid
'.Border.Weight = Thick
End With
'With .Title
'.Caption = Balance
'.Font.Name = "Verdana"
'.Font.Size = 10
'.Font.Bold = True
'.Font.Color = RGB(50, 205, 50)
'End With
With .Axes(0).Font
.Name = "Verdana"
.Size = 8
'.Bold = True
.Color = RGB(255, 255, 255)
End With
With .Axes(1).Font
.Name = "Verdana"
.Size = 8
'.Bold = True
.Color = RGB(255, 255, 255)
End With
'With .Axes(0).MinorGridlines
'.Line.Color = RGB(255, 255, 255)
'End With
'With .Axes(0).MajorGridlines
'.Line.Color = RGB(255, 255, 255)
'End With
'With .Axes(1).MinorGridlines
'.Line.Color = RGB(255, 255, 255)
'End With
'With .Axes(1).MajorGridlines
'.Line.Color = RGB(255, 255, 255)
'End With
With .SeriesCollection(0)
'.Border.Color = RGB(255, 255, 255)
.Interior.Color = vbGreen
.Caption = Balance
.Line.Color = RGB(255, 255, 255)
End With
'With .SeriesCollection(1)
'.Interior.Color = vbBlue
'.Caption = Balance
'End With
'.HasLegend = True
'With .Legend
'.Position = chLegendPositionBottom
'.Border.Color = vbWhite
'.LegendEntries(2).Visible = False
'End With
End With
'------------------------------------------------------------------------
End Sub
Private Sub cmdClose_History_Click()
Unload Me
frmMenu.Show
End Sub
Private Sub History_Select_Debtor_Change()
'--------Total Purchased-----------------------------------------------
'Worksheets("InvoiceList").Rows(1).AutoFilter Field:=1, Criteria1:="=" & Me.History_Select_Debtor
'Me.txtPurchased = Worksheets("Summary").[C2] 'the cell containing the SUBTOTAL
'-------------------------------------------------------
Label6.Visible = True
Label7.Visible = True
Label8.Visible = True
Label9.Visible = True
Label10.Visible = True
Label11.Visible = True
Label12.Visible = True
FilterList 0, Me.History_Select_Debtor.Text
Me.cmdClose_History.SetFocus
Dim ws As Worksheet
Dim Rw As Long
Set ws = Worksheets("DebtorList")
'Get row based on ComboBox ListIndex
With Me
'Starting point of lookup data
Rw = .History_Select_Debtor.ListIndex + 2
'Data to be displayed based on selection
txtBalance.Value = FormatCurrency(Expression:=ws.Cells(Rw, 2).Value, _
NumDigitsAfterDecimal:=2)
End With
'-------Total Transactions----------------------------------------------------------------------------------------------------------------------
Set ws = Worksheets("DebtorList")
With Me
'Starting point of lookup data
Rw = .History_Select_Debtor.ListIndex + 2
History_Select_Debtor.List = Range("Debtor_list_Debtors").Value
txtTransactions.Value = Application.CountIf(Range("Invoice_list_Debtor"), History_Select_Debtor)
End With
'-------Total Payed------------------------------------------------------------------------------------------------------------------------------
txtPayed.Value = FormatCurrency(Expression:=Application.SumIf(Range("Invoice_list_Debtor"), _
History_Select_Debtor.Value, Range("Invoice_list_Price")), _
NumDigitsAfterDecimal:=2)
End Sub
Private Sub UserForm_QueryClose _
(Cancel As Integer, CloseMode As Integer)
' Prevents use of the Close button
If CloseMode = vbFormControlMenu Then
Cancel = True
End If
End Sub
Private Sub FilterList(iCtrl As Long, sText As String)
Dim iRow As Long
Dim ws As Worksheet
Dim sCrit As String
sCrit = "*" & UCase(sText) & "*"
Set ws = Worksheets("InvoiceList")
With Me.ListBox1
ListTable = ws.Range("A65536").End(xlUp).Row
.List = ws.Range("A2:G" & ListTable).Value
For iRow = .ListCount - 1 To 0 Step -1
If Not UCase(.List(iRow, iCtrl)) Like sCrit Then
.RemoveItem iRow
End If
Next iRow
'Determine number of columns
.ColumnCount = 7
'Set column widths
.ColumnWidths = "50;80;70;100;80;80;80"
'Insert the range of data supplied
For x = 2 To 3 'loop the numeric columns - 3 to 4
For i = 0 To .ListCount - 1 'loop through the rows of columns 3 to 5
.List(i, x) = Format(.List(i, x), "$#,##")
Next i
Next x
For x = 5 To 6 'loop the numeric columns - 4 to 5
For i = 0 To .ListCount - 1 'loop through the rows of columns 3 to 5
.List(i, x) = Format(.List(i, x), "$#,##")
Next i
Next x
For x = 4 To 4 'loop the numeric columns - 3 to 4
For i = 0 To .ListCount - 1 'loop through the rows of columns 3 to 5
.List(i, x) = Format(.List(i, x), "[$-409]h:mm AM/PM;#")
Next i
Next x
End With
End Sub

Answer 1

There is more than one issue here I believe ...
To get the total number of invoiced items for a debtor you can
(auto)filter the InvoiceList for your current Debtor
display the sum of invoiced items using the =SUBTOTAL(109,InvoiceSheet!$F:$F) worksheet function (asuming the invoice sheet is named [InvoiceSheet] ;-) )
I would even suggest to have that =SUBTOTAL on a seperate sheet (Sheet2), so it's location is constant. Don't use ControlSource() on the text field in the dialog, but set Locked = True
You can set up Autofilter on [InvoiceSheet] once and use the Sub
Private Sub History_Select_Debtor_Change()
Worksheets("InvoiceSheet").Rows(1).AutoFilter field:=1, Criteria1:="=" & Me.History_Select_Debtor
Me.txtPurchased = Worksheets("Sheet2").[A1] 'the cell containing the SUBTOTAL
End Sub
to fire the filter and get the value of the SUBTOTAL formula back into the dialog.
For the transition of quantities from text to number I would suggest to create an extra sheet [QTYCode] looking like
A B ...
+------------+-----+----
1 |Text |Value|
2 |Quarter item| 0.25|
3 |Half item | 0.5|
4 |1 item | 1|
5 |2 item | 2|
6 |3 item | 3|
...
where column A (except header row) serves as RowSource() for the QTY selection box, and for each record you create in [InvoiceSheet] you save not only the selected QTYText, but as well an extra column containing a =VLOOKUP() formula that converts text into value (and base your =SUBTOTAL() on that new column - of course)
Hope that helps
Good luck - MikeD