need new procedure in listbox on userform for average prices

[abdo meghari]

Hi,
I will add TB6,TB7 when writing dates to search data within showed in listbox ,
also when run the form should merge data on form for PURCHASE ,SALES sheets.
brings just BRAND from PURCHASE sheet based on BRANDS are existed in SALES sheet , ignore new brands in PURCHASE sheet.
so should be as the picture

should merge QTY based on BRAND column for SALES sheet, as SALES header will sum TOTAL column and divide on QTY sum
ex: BS 1200R20 G580 JAP =81600/40=2040
as PURCHASE header =100500/50=2010
as formula in TOTAL column=(2040-2010)*40
add sum word in first column and sum columns 3:5 as show in listbox.
I look forward if there is way to bold fonts for headers and SUM row in last row in listbox
the data in sheets.

populating data on form.xlsm
	A	B	C	D	E	F	G
1	DATE	CUTOMER	ID	BRAND	QTY	UNIT PRICE	TOTAL
2	01/01/2023	CRR-100	BSJ100	BS 1200R20 G580 JAP	20.00	2,000.00	40,000.00
3	02/01/2023	CRR-101	BSJ101	BS 750R16 R230 JAP	10.00	715.00	7,150.00
4	03/01/2023	CRR-102	BSJ102	BS 750R16 VSJ JAP	20.00	730.00	14,600.00
5	04/01/2023	CRR-101	BSJ100	BS 1200R20 G580 JAP	20.00	2,035.00	40,700.00
6	05/01/2023	CRR-101	BSJ102	BS 750R16 VSJ JAP	10.00	710.00	7,100.00
7	06/01/2023	CRR-100	BSJ100	BS 1200R20 G580 JAP	10.00	1,980.00	19,800.00
8	07/01/2023	CRR-103	BSJ103	BS 1200R20 G580 THI	50.00	2,025.00	101,250.00
9	08/01/2023	CRR-104	BSJ104	BS 1200R20 R187 JAP	10.00	1,980.00	19,800.00
10	09/01/2023	CRR-105	BSJ105	BS 205/70R15C R623	50.00	400.00	20,000.00
11	10/01/2023	CRR-105	BSJ103	BS 1200R20 G580 THI	40.00	2,000.00	80,000.00
12	11/01/2023	CRR-104	BSJ105	BS 205/70R15C R623	15.00	430.00	6,450.00
13	12/01/2023	CRR-101	BSJ105	BS 205/70R15C R623	20.00	440.00	8,800.00
PURCHASE

Cell Formulas
Range	Formula
G2:G13	G2	=E2*F2

populating data on form.xlsm
	A	B	C	D	E	F	G
1	DATE	CUTOMER	ID	BRAND	QTY	UNIT PRICE	TOTAL
2	01/02/2023	SRR-100	BSJ100	BS 1200R20 G580 JAP	20.00	2,000.00	40,000.00
3	02/02/2023	SRR-100	BSJ105	BS 205/70R15C R623	5.00	460.00	2,300.00
4	03/02/2023	SRR-101	BSJ105	BS 205/70R15C R623	5.00	465.00	2,325.00
5	04/02/2023	SRR-101	BSJ101	BS 750R16 R230 JAP	2.00	740.00	1,480.00
6	05/02/2023	SRR-102	BSJ101	BS 750R16 R230 JAP	2.00	755.00	1,510.00
7	05/02/2023	SRR-103	BSJ101	BS 750R16 R230 JAP	2.00	760.00	1,520.00
8	06/02/2023	SRR-100	BSJ100	BS 1200R20 G580 JAP	20.00	2,080.00	41,600.00
SALES

Cell Formulas
Range	Formula
G2:G8	G2	=E2*F2

without effect the others procedures
based on the others procedures will select option button based on sheet name then will show data for sheet name and search in textbox2 for brand to merge QTY and calculate price in others textboxs , so should keep theses procedures without any change when add new procedure as in above procedure
here is the procedures

Option Explicit
Dim a As Variant


Sub FilterData()
  Dim txt1 As String
    Dim Tot4 As Double, Tot5 As Double, Tot6 As Double        '++

  Dim i As Long, j As Long, k As Long
  ListBox1.Clear
  ReDim b(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a)
    If TextBox2 = "" Then txt1 = a(i, 4) Else txt1 = TextBox2
  
    If LCase(a(i, 4)) Like LCase(txt1) & "*" Then
  
    
      k = k + 1
      For j = 1 To 7
      If j = 1 Then 'Change the 1 in this line for the column number where you have the date
          b(k, j) = Format(a(i, j), "dd/mm/yyyy")
       
        
        
        Else
          b(k, j) = a(i, j)
        If k = 1 And j = 3 Then Me.TextBox1.Value = a(i, j)       '+++

        End If
      
      Next
    End If
  Next
  If k > 0 Then ListBox1.List = b
  With ListBox1
  .ColumnWidths = "80;80;80;180;100;80;80"
 
       For i = 0 To .ListCount - 1
            Tot4 = Tot4 + .List(i, 4)                       '++
            .List(i, 4) = Format(.List(i, 4), "#,##0.00")
            Tot5 = Tot5 + .List(i, 5)                       '++
            .List(i, 5) = Format(.List(i, 5), "#,##0.00")
            Tot6 = Tot6 + .List(i, 6)                       '++
            .List(i, 6) = Format(.List(i, 6), "#,##0.00")
        Next i
  End With
 Me.TextBox3.Value = Format(Tot4, "#,##0.00")
  If Tot4 > 0 Then
    Me.TextBox4.Value = Format(Tot6 / Tot4, "#,##0.00")
  Else
    Me.TextBox4.Text = ""
  End If
  Me.TextBox5.Value = Tot6
  
 
 
 
End Sub


Private Sub OptionButton1_Click()
    If OptionButton1.Value = True And OptionButton2.Value = False Then sheet5.Select
    Call ChangeSheet
    Call FilterData
End Sub

Private Sub OptionButton2_Click()
    If OptionButton2.Value = True And OptionButton1.Value = False Then sheet6.Select
    Call ChangeSheet
    Call FilterData
End Sub

Private Sub TextBox2_Change()
Call FilterData
End Sub



Private Sub ChangeSheet()
    With ActiveSheet
        a = .Range("A2:G" & .Range("D" & Rows.Count).End(3).Row).Value
    End With
End Sub

I hope to getting chance to complete this project.

 

[DanteAmor]

Answer the questions:

************************

I look forward if there is way to bold fonts for headers and SUM row in last row in listbox
the data in sheets.

1. That's not possible in the listbox, do you still want help?
************************


************************

without effect the others procedures

2. According to the code, you only have one filter for TextBox2, is this correct?
************************


************************

based on the others procedures will select option button based on sheet name then will show data for sheet name and search in textbox2 for brand to merge QTY and calculate price in others textboxs

3. Instead of OptionButton, you would prefer CheckBox, this way you can select sheet "PURCHASE", or sheet "SALES" or both and then the macro will merge the 2 sheets, just as you ask at this point:

also when run the form should merge data on form for PURCHASE ,SALES sheets.

************************

************************

I hope to getting chance to complete this project.

4. You could put an image of the result in the listbox, when you select the "PURCHASE" sheet and with a date range.

And I would like to help you, but you must answer each of my questions.
************************

 

[DanteAmor]

so should keep theses procedures without any change when add new procedure

5. Another question, according to your previous comment, the filter by dates (tb6 and tb7) does not apply in your current procedure, it only applies to the new procedure and will it filter by dates in the merge of the 2 sheets?
*********************************


6. In the new procedure, does the filter apply by brand (tb2)?

 

[abdo meghari]

1. That's not possible in the listbox

ok that's understood .

do you still want help?

surely .

2. According to the code, you only have one filter for TextBox2, is this correct?

yes that's correct.

3. Instead of OptionButton, you would prefer CheckBox, this way you can select sheet "PURCHASE", or sheet "SALES" or both and then the macro will merge the 2 sheets, just as you ask at this point:

ok I don't mind .

4. You could put an image of the result in the listbox, when you select the "PURCHASE" sheet and with a date range.

when select both sheets and write dates

when select specific sheet with dates

I would correct error in last brand contains error in QTY and I would show items column in first column.

without dates

without forgetting show data for each sheet when select one of them in listbox .

5. Another question, according to your previous comment, the filter by dates (tb6 and tb7) does not apply in your current procedure, it only applies to the new procedure and will it filter by dates in the merge of the 2 sheets?

yes should be.

6. In the new procedure, does the filter apply by brand (tb2)?

yes should be .
I hope to answered for all of questions.

 

[DanteAmor]

I have more questions.

Your explanations are not clear.

++++++++++++++++++++++++++++++++++++++++++++++
1. It is ambiguous in the dates:

brings just BRAND from PURCHASE sheet based on BRANDS are existed in SALES sheet

​

​

If you put those dates, in the "SALES" sheet there are no brands between those dates:

​

So there are no brands on the "SALES" sheet that meet the date range, so it should bring records from the "PURCHASE" sheet
++++++++++++++++++++++++++++++++++++++++++++++


++++++++++++++++++++++++++++++++++++++++++++++
2. You specifically asked that the current procedure not be modified, so you want it modified to filter by date?

++++++++++++++++++++++++++++++++++++++++++++++


++++++++++++++++++++++++++++++++++++++++++++++
3. The ITEM column was not in your original post, therefore it will not be integrated into the solution.

++++++++++++++++++++++++++++++++++++++++++++++


I think that since your requirement has several errors, you should rewrite it.
In summary, you have 3 filters:
1. By sheet
2. By date
3. By brand
You must specify when it applies to a single sheet and when it applies to 2 sheets.
Remember that your examples must be consistent with your specifications.

 

[abdo meghari]

about error month sorry about it , based on my explenation should be JAN , not FEB
so should be

populating data on form1.xlsm
	A	B	C	D	E	F	G
1	DATE	CUTOMER	ID	BRAND	QTY	UNIT PRICE	TOTAL
2	01/01/2023	SRR-100	BSJ100	BS 1200R20 G580 JAP	20.00	2,000.00	40,000.00
3	02/01/2023	SRR-100	BSJ105	BS 205/70R15C R623	5.00	460.00	2,300.00
4	03/01/2023	SRR-101	BSJ105	BS 205/70R15C R623	5.00	465.00	2,325.00
5	04/01/2023	SRR-101	BSJ101	BS 750R16 R230 JAP	2.00	740.00	1,480.00
6	05/01/2023	SRR-102	BSJ101	BS 750R16 R230 JAP	2.00	755.00	1,510.00
7	05/01/2023	SRR-103	BSJ101	BS 750R16 R230 JAP	2.00	760.00	1,520.00
8	06/01/2023	SRR-100	BSJ100	BS 1200R20 G580 JAP	20.00	2,080.00	41,600.00
SALES

Cell Formulas
Range	Formula
G2:G8	G2	=E2*F2

2. You specifically asked that the current procedure not be modified, so you want it modified to filter by date?

yes should modify

3. The ITEM column was not in your original post, therefore it will not be integrated into the solution.

I know , it's up to you.
so when select sheet

when select sheet and dates

and when select sheet and dates and brand

and based on correct month in sales sheet and just select two sheets with two dates

select two sheets without dates

finally I don't need brand in textbox1 when merge two sheets if you would do it too I don't mind .

 

[DanteAmor]

I think everything is there , including headers and the item column that you didn't ask for in the original post.

Option Explicit
Dim a As Variant, b As Variant, a2 As Variant

Sub FilterData()
  Dim tb2 As String
  Dim tb6 As Date, tb7 As Date
  Dim sumSale As Double, sumPurc As Double, sumTota As Double
  Dim i&, j&, k&, y&, nRow&
  Dim dic As Object
  Dim c As Variant, d As Variant, e As Variant
  Dim dt As String
  Const frm As String = "#,##0.00"
  
  Set dic = CreateObject("Scripting.Dictionary")

  'Date validation
  dt = DateValidation
  If dt = "" Then Exit Sub
  If dt <> "2" Then MsgBox dt: Exit Sub
  
  'Sales keys
  For i = 1 To UBound(b, 1)
    dic(b(i, 4)) = Empty
  Next
  
  'Filter purchases with sales keys
  ReDim c(1 To UBound(a, 1), 1 To UBound(a, 2))
  For i = 1 To UBound(a, 1)
    If dic.exists(a(i, 4)) Then
      k = k + 1
      For j = 1 To UBound(a, 2)
        c(k, j) = a(i, j)
      Next
    End If
  Next
  dic.RemoveAll
  
  'Filter Sales sheet
  ReDim d(1 To UBound(b, 1), 1 To UBound(b, 2))
  For i = 1 To UBound(b)
    If TextBox2.Value = "" Then tb2 = b(i, 4) Else tb2 = TextBox2.Value
    If TextBox6.Value = "" Then tb6 = CDate(b(i, 1)) Else tb6 = CDate(TextBox6.Value)
    If TextBox7.Value = "" Then tb7 = CDate(b(i, 1)) Else tb7 = CDate(TextBox7.Value)
    If CDate(b(i, 1)) >= tb6 And CDate(b(i, 1)) <= tb7 And _
       LCase(b(i, 4)) Like LCase(tb2) & "*" Then
      k = k + 1
      
      If Not dic.exists(b(i, 4)) Then
        y = y + 1
        dic(b(i, 4)) = y
      End If
      nRow = dic(b(i, 4))
      d(nRow, 1) = b(i, 3)
      d(nRow, 2) = b(i, 4)
      d(nRow, 3) = d(nRow, 3) + b(i, 5)
      d(nRow, 4) = d(nRow, 4) + b(i, 7)
      d(nRow, 5) = 0
      d(nRow, 7) = 0
    End If
  Next
  
  'Filter Purchase sheet
  For i = 1 To UBound(c)
    If TextBox2.Value = "" Then tb2 = c(i, 4) Else tb2 = TextBox2.Value
    If TextBox6.Value = "" Then tb6 = CDate(c(i, 1)) Else tb6 = CDate(TextBox6.Value)
    If TextBox7.Value = "" Then tb7 = CDate(c(i, 1)) Else tb7 = CDate(TextBox7.Value)
    If CDate(c(i, 1)) >= tb6 And CDate(c(i, 1)) <= tb7 And _
       LCase(c(i, 4)) Like LCase(tb2) & "*" Then
      k = k + 1
      If c(i, 4) = "" Then
        Exit For
      End If
    
      If dic.exists(c(i, 4)) Then
        nRow = dic(c(i, 4))
        d(nRow, 5) = d(nRow, 5) + c(i, 7)
        d(nRow, 7) = d(nRow, 7) + c(i, 5)
      End If
    
    End If
  Next
  
  ReDim e(1 To dic.Count + 2, 1 To 7)
  e(1, 1) = "ITEM"
  e(1, 2) = "ID"
  e(1, 3) = "BRAND"
  e(1, 4) = "QTY"
  e(1, 5) = "SALES"
  e(1, 6) = "PURCHASE"
  e(1, 7) = "TOTAL"
  k = 2
  For i = 1 To dic.Count ' UBound(d, 1)
    e(k, 1) = i
    e(k, 2) = d(i, 1)
    e(k, 3) = d(i, 2)
    e(k, 4) = Format(d(i, 3), frm)
    If d(i, 3) > 0 Then
      e(k, 5) = Format(d(i, 4) / d(i, 3), frm)
    Else
      e(k, 5) = Format(0, frm)
    End If
    sumSale = sumSale + CDbl(e(k, 5))
    If d(i, 7) > 0 Then
      e(k, 6) = Format(d(i, 5) / d(i, 7), frm)
    Else
      e(k, 6) = Format(0, frm)
    End If
    sumPurc = sumPurc + CDbl(e(k, 6))
    e(k, 7) = Format((CDbl(e(k, 5)) - CDbl(e(k, 6))) * e(k, 4), frm)
    sumTota = sumTota + CDbl(e(k, 7))
    If k = 2 Then Me.TextBox1.Value = a2(i, 3)
    k = k + 1
  Next
  e(k, 1) = "SUM"
  e(k, 5) = Format(sumSale, frm)
  e(k, 6) = Format(sumPurc, frm)
  e(k, 7) = Format(sumTota, frm)
  
  With ListBox1
    .ColumnWidths = "50;80;180;80;80;80;80"
    .List = e
  End With
End Sub

Sub FilterData_2()
  Dim tb2 As String
  Dim tb6 As Date, tb7 As Date
  Dim Tot4 As Double, Tot5 As Double, Tot6 As Double        '++
  Dim i As Long, j As Long, k As Long
  Dim dt As String
  Const frm As String = "#,##0.00"
  
  'Date validation
  dt = DateValidation
  If dt = "" Then Exit Sub
  If dt <> "2" Then MsgBox dt: Exit Sub
  
  ReDim d(1 To UBound(a2, 1) + 1, 1 To UBound(a2, 2))
  d(1, 1) = "ITEM"
  d(1, 2) = "ID"
  d(1, 3) = "BRAND"
  d(1, 4) = "QTY"
  d(1, 5) = "UNIT PRICE"
  d(1, 6) = "TOTAL"
  k = 1
  
  For i = 1 To UBound(a2)
    If TextBox2.Value = "" Then tb2 = a2(i, 4) Else tb2 = TextBox2.Value
    If TextBox6.Value = "" Then tb6 = CDate(a2(i, 1)) Else tb6 = CDate(TextBox6.Value)
    If TextBox7.Value = "" Then tb7 = CDate(a2(i, 1)) Else tb7 = CDate(TextBox7.Value)
    If CDate(a2(i, 1)) >= tb6 And CDate(a2(i, 1)) <= tb7 And _
       LCase(a2(i, 4)) Like LCase(tb2) & "*" Then
  
      k = k + 1
      d(k, 1) = k - 1
      d(k, 2) = a2(i, 3)
      d(k, 3) = a2(i, 4)
      d(k, 4) = Format(a2(i, 5), frm)
      Tot4 = Tot4 + a2(i, 5)
      d(k, 5) = Format(a2(i, 6), frm)
      Tot5 = Tot5 + a2(i, 6)
      d(k, 6) = Format(a2(i, 7), frm)
      Tot6 = Tot6 + a2(i, 7)
      If k = 2 Then Me.TextBox1.Value = a2(i, 3)        '+++
    End If
  Next
  If k > 0 Then
    With ListBox1
      .List = d
      .ColumnWidths = "80;80;180;80;80;80"
    End With
  End If
  TextBox3.Value = Format(Tot4, frm)
  If Tot4 > 0 Then
    TextBox4.Value = Format(Tot6 / Tot4, frm)
  Else
    TextBox4.Text = Format(0, frm)
  End If
  TextBox5.Value = Format(Tot6, frm)
End Sub

Private Sub CheckBox1_Click()
  Call SelectFilter
End Sub
Private Sub CheckBox2_Click()
  Call SelectFilter
End Sub
Private Sub TextBox2_Change()
  Call SelectFilter
End Sub
Private Sub TextBox6_Change()
  Call SelectFilter
End Sub
Private Sub TextBox7_Change()
  Call SelectFilter
End Sub

Sub SelectFilter()
  Call ClearControls
  Select Case True
    Case CheckBox1.Value = True And CheckBox2.Value = False
      a2 = sheet5.Range("A2:G" & sheet5.Range("D" & Rows.Count).End(3).Row).Value
      Call FilterData_2
    Case CheckBox1.Value = False And CheckBox2.Value = True
      a2 = sheet6.Range("A2:G" & sheet6.Range("D" & Rows.Count).End(3).Row).Value
      Call FilterData_2
    Case CheckBox1.Value = True And CheckBox2.Value = True
      Call FilterData
  End Select
End Sub

Sub ClearControls()
  ListBox1.Clear
  TextBox1.Value = ""
  TextBox3.Value = ""
  TextBox4.Value = ""
  TextBox5.Value = ""
End Sub

Function DateValidation()
  DateValidation = ""
  If Len(TextBox6.Value) <> 10 And TextBox6.Value <> "" Then Exit Function
  If Len(TextBox7.Value) <> 10 And TextBox7.Value <> "" Then Exit Function
  If Not IsDate(TextBox6.Value) And TextBox6.Value <> "" Then Exit Function
  If Not IsDate(TextBox7.Value) And TextBox7.Value <> "" Then Exit Function
  If TextBox6.Value <> "" And TextBox7.Value = "" Then Exit Function
  If TextBox6.Value = "" And TextBox7.Value <> "" Then Exit Function
  If TextBox6.Value <> "" And TextBox7.Value <> "" Then
    If CDate(TextBox7.Value) < CDate(TextBox6.Value) Then
      DateValidation = "The end date is less than the start date"
      Exit Function
    End If
  End If
  DateValidation = "2"
End Function

Private Sub UserForm_Activate()
  a = sheet5.Range("A2:G" & sheet5.Range("D" & Rows.Count).End(3).Row).Value  'Purchase sheet
  b = sheet6.Range("A2:G" & sheet6.Range("D" & Rows.Count).End(3).Row).Value  'Sales sheet
End Sub

 

[abdo meghari]

every thing is great !
sorry for make you confusing because of errors!
thank you so much.