need new procedure in listbox on userform for average prices

abdo meghari

Well-known Member
Joined
Aug 3, 2021
Messages
718
Office Version
  1. 2019
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
ABCDEFG
1DATECUTOMERIDBRANDQTYUNIT PRICETOTAL
201/01/2023CRR-100BSJ100BS 1200R20 G580 JAP20.002,000.0040,000.00
302/01/2023CRR-101BSJ101BS 750R16 R230 JAP10.00715.007,150.00
403/01/2023CRR-102BSJ102BS 750R16 VSJ JAP20.00730.0014,600.00
504/01/2023CRR-101BSJ100BS 1200R20 G580 JAP20.002,035.0040,700.00
605/01/2023CRR-101BSJ102BS 750R16 VSJ JAP10.00710.007,100.00
706/01/2023CRR-100BSJ100BS 1200R20 G580 JAP10.001,980.0019,800.00
807/01/2023CRR-103BSJ103BS 1200R20 G580 THI50.002,025.00101,250.00
908/01/2023CRR-104BSJ104BS 1200R20 R187 JAP10.001,980.0019,800.00
1009/01/2023CRR-105BSJ105BS 205/70R15C R62350.00400.0020,000.00
1110/01/2023CRR-105BSJ103BS 1200R20 G580 THI40.002,000.0080,000.00
1211/01/2023CRR-104BSJ105BS 205/70R15C R62315.00430.006,450.00
1312/01/2023CRR-101BSJ105BS 205/70R15C R62320.00440.008,800.00
PURCHASE
Cell Formulas
RangeFormula
G2:G13G2=E2*F2



populating data on form.xlsm
ABCDEFG
1DATECUTOMERIDBRANDQTYUNIT PRICETOTAL
201/02/2023SRR-100BSJ100BS 1200R20 G580 JAP20.002,000.0040,000.00
302/02/2023SRR-100BSJ105BS 205/70R15C R6235.00460.002,300.00
403/02/2023SRR-101BSJ105BS 205/70R15C R6235.00465.002,325.00
504/02/2023SRR-101BSJ101BS 750R16 R230 JAP2.00740.001,480.00
605/02/2023SRR-102BSJ101BS 750R16 R230 JAP2.00755.001,510.00
705/02/2023SRR-103BSJ101BS 750R16 R230 JAP2.00760.001,520.00
806/02/2023SRR-100BSJ100BS 1200R20 G580 JAP20.002,080.0041,600.00
SALES
Cell Formulas
RangeFormula
G2:G8G2=E2*F2



STRR.PNG

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
VBA Code:
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.
 

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top