Merge data on userform for each sheet based on multiple columns.

[Maklil]

Hi Guys,
I expect data could reach for about 12000 rows for each sheet.
so I would show this report on userform as in picture when there are no dates in TB1,TB2.

mk.xlsm
	A	B	C	D	E	F	G	H	I
1	DATE	INV NO	NAME	ID	CASE	SAFES	QTY	UNIT PRICE	BALANCE
2	20/08/2023	MMUY7000	MVS	OOIL AS-100	PAID	ASDFT SAFE	20.00	160.00	3,200.00
3	20/08/2023	MMUY7000	MVS	OOIL AS-101	PAID	ASDFT SAFE	20.00	180.00	3,600.00
4	TOTAL								6,800.00
5	20/08/2023	MMUY7001	MVS	OOIL AS-102	PAID	ASDFT SAFE	40.00	155.00	6,200.00
6	20/08/2023	MMUY7001	MVS	OOIL AS-103	PAID	ASDFT SAFE	20.00	190.00	3,800.00
7	TOTAL								10,000.00
8	21/08/2023	MMUY7002	MVS	OOIL AS-103	NOT PAID		25.00	190.00	4,750.00
9	TOTAL								4,750.00
10	21/08/2023		MSS	OOIL AS-103	NOT PAID		25.00	180.00	4,500.00
11	21/08/2023		MSS	OOIL AS-104	NOT PAID		40.00	177.00	7,080.00
12	TOTAL			OOIL AS-105					11,580.00
13	21/08/2023	MMUY7002	MVS	OOIL AS-103	PAID	YOUSEF SAFE	100.00	196.00	19,600.00
14	TOTAL								19,600.00
MK

Cell Formulas
Range	Formula
I13,I10:I11,I8,I5:I6,I2:I3	I2	=G2*H2
I4,I12,I7	I4	=SUM(I2:I3)
I9,I14	I9	=SUM(I8)

mk.xlsm
	A	B	C	D	E	F	G	H	I
1	DATE	INV NO	NAME	ID	CASE	SAFES	QTY	UNIT PRICE	BALANCE
2	20/08/2023	ST NO 1000	MVS	GNOO HH 1200	RECEIVED	YOUSEF SAFE	10.00	150.00	1,500.00
3	20/08/2023	ST NO 1000	MVS	AS100-12	RECEIVED	YOUSEF SAFE	10.00	130.00	1,300.00
4	TOTAL								2,800.00
5	21/08/2023	ST NO 1001	MTT	MGFH GA-103	NOT REICEVED		15.00	130.00	1,950.00
6	TOTAL								1,950.00
7	21/08/2023	ST NO 1002	MLL	SSFOO 1000 MN1	NOT REICEVED		2.00	140.00	280.00
8	21/08/2023	ST NO 1002	MLL	SSFOO 1000 MN2	NOT REICEVED		12.00	145.00	1,740.00
9	21/08/2023	ST NO 1002	MLL	SSFOO 1000 MN3	NOT REICEVED		10.00	145.00	1,450.00
10	TOTAL								3,470.00
11	24/08/2023	VT NO 1003	MKK	OOIL AS-100	RECEIVED	YOUSEF SAFE	10.00	145.00	1,450.00
12	24/08/2023	VT NO 1003	MKK	OOIL AS-101	RECEIVED	YOUSEF SAFE	25.00	150.00	3,750.00
13	24/08/2023	VT NO 1003	MKK	OOIL AS-102	RECEIVED	YOUSEF SAFE	40.00	155.00	6,200.00
14	24/08/2023	VT NO 1003	MKK	OOIL AS-103	RECEIVED	YOUSEF SAFE	55.00	160.00	8,800.00
15	24/08/2023	VT NO 1003	MKK	OOIL AS-104	RECEIVED	YOUSEF SAFE	70.00	165.00	11,550.00
16	24/08/2023	VT NO 1003	MKK	OOIL AS-105	RECEIVED	YOUSEF SAFE	85.00	170.00	14,450.00
17	24/08/2023	VT NO 1003	MKK	OOIL AS-106	RECEIVED	YOUSEF SAFE	100.00	175.00	17,500.00
18	24/08/2023	VT NO 1003	MKK	OOIL AS-107	RECEIVED	YOUSEF SAFE	115.00	180.00	20,700.00
19	TOTAL								84,400.00
20	24/08/2023	ST NO 1002	MLL	SSFOO 1000 MN11	NOT REICEVED		12.00	160.00	1,920.00
21	24/08/2023	ST NO 1002	MLL	SSFOO 1000 MN21	NOT REICEVED		12.00	170.00	2,040.00
22	TOTAL								3,960.00
MT

Cell Formulas
Range	Formula
I11:I18,I5,I2:I3	I2	=G2*H2
I4,I22	I4	=SUM(I2:I3)
I6	I6	=SUM(I5:I5)
I20:I21,I7:I9	I7	=H7*G7
I10	I10	=SUM(I7:I9)
I19	I19	=SUM(I11:I18)

mk.xlsm
	A	B	C	D	E	F	G	H	I
1	DATE	INV NO	NAME	ID	CASE	SAFES	QTY	UNIT PRICE	BALANCE
2	20/08/2023	MSSUY4000	MVS	OOIL AS-100	RECEIVED	AFORI BANK	1.00	160.00	160.00
3	20/08/2023	MSSUY4000	MVS	OOIL AS-101	RECEIVED	AFORI BANK	1.00	180.00	180.00
4	TOTAL								340.00
5	20/08/2023	MSSUY4001	MVS	OOIL AS-102	NOT REICEVED		1.00	155.00	155.00
6	20/08/2023	MSSUY4001	MVS	OOIL AS-103	NOT REICEVED		1.00	190.00	190.00
7	TOTAL								345.00
8	21/08/2023	MSSUY4002	MVS	OOIL AS-102	RECEIVED	AMTOR BANK	2.00	155.00	310.00
9	TOTAL								310.00
10	21/08/2023	MSSUY4003	MSS	OOIL AS-100	NOT REICEVED		1.00	160.00	160.00
11	21/08/2023	MSSUY4003	MSS	OOIL AS-101	NOT REICEVED		1.00	180.00	180.00
12	21/08/2023	MSSUY4003	MSS	OOIL AS-102	NOT REICEVED		1.00	155.00	155.00
13	TOTAL								495.00
MS

Cell Formulas
Range	Formula
I10:I12,I8,I5:I6,I2:I3	I2	=G2*H2
I4,I7	I4	=SUM(I2:I3)
I9	I9	=SUM(I8)
I13	I13	=SUM(I10:I12)

mk.xlsm
	A	B	C	D	E	F	G	H	I
1	DATE	INV NO	NAME	ID	CASE	SAFES	QTY	UNIT PRICE	BALANCE
2	24/08/2023	VT NO 1003	MKK	OOIL AS-100	NOT PAID		1.00	145.00	145.00
3	24/08/2023	VT NO 1003	MKK	OOIL AS-101	NOT PAID		1.00	150.00	150.00
4	24/08/2023	VT NO 1003	MKK	OOIL AS-102	NOT PAID		2.00	155.00	310.00
5	24/08/2023	VT NO 1003	MKK	OOIL AS-103	NOT PAID		4.00	160.00	640.00
6	TOTAL								1,245.00
7	25/08/2023	VT NO 1004	MKK	OOIL AS-101	PAID	YOUSEF SAFE	1.00	150.00	150.00
8	25/08/2023	VT NO 1004	MKK	OOIL AS-102	PAID	YOUSEF SAFE	2.00	155.00	310.00
9	TOTAL								460.00
10	25/08/2023	VT NO 1005	MLL	OOIL AS-103	PAID	ASTORI BANK	4.00	160.00	640.00
11	TOTAL								640.00
12	25/08/2023	VT NO 1006	MLL	OOIL AS-102	PAID	YOUSEF SAFE	2.00	155.00	310.00
13	25/08/2023	VT NO 1006	MLL	OOIL AS-103	PAID	YOUSEF SAFE	4.00	160.00	640.00
14	TOTAL								950.00
15	25/08/2023	VT NO 1007	MKK	OOIL AS-101	PAID	ASTORI BANK	3.00	150.00	450.00
16	TOTAL								450.00
ATS

Cell Formulas
Range	Formula
I15,I12:I13,I10,I7:I8,I2:I5	I2	=G2*H2
I6	I6	=SUM(I2:I5)
I9,I14	I9	=SUM(I7:I8)
I11,I16	I11	=SUM(I10)

mk.xlsm
	A	B	C	D	E	F
1	DATE	VOUCHER NO	NAME	CASE	SAFES	TOTAL
2	20/08/2023	VDD1000	MVS	PAID	ASDFT SAFE	200
3	21/08/2023	VDD1001	MVS	PAID	ASDFT SAFE	120
4	22/08/2023	VDD1002	MKK	RECEIVED	YOUSEF SAFE	100
5	23/08/2023	VDD1003	MVS	RECEIVED	YOUSEF SAFE	120
6	23/08/2023	VDD1004	MKK	PAID	AFORI BANK	120
7	24/08/2023	VDD1005	MKK	PAID	YOUSEF SAFE	100
8	25/08/2023	VDD1006	MVS	PAID	AFORI BANK	200
9	25/08/2023	VDD1007	MVS	PAID	YOUSEF SAFE	100
10	25/08/2023	VDD1008	MKK	RECEIVED	AFORI BANK	120
VFTY

1- in column(2) in listbox will show sheets names
2- in column(3) in listbox will show items under SAFES column across sheets.
3- column(4) in listbox will brings amount is existed in TOTAL row for column|(I) for each sheet and merge amounts for duplicates items in SAFES column , CASE column together for each sheet alone.
4- and should show zero as hyphen for each digit in columns don't contain amount .
5- as to amounts for NOTPAID,NOT RECEIVED don't contain item in SAFES column then should show for first row for each sheet.
6- should sreach within two dates in TB1,TB2
by the way I have got solution by Dante amore like really similar project but unfortunately I have to change some things .
thanks .

 

[Maklil]

Which sheets are you referring to here 'then should show for first row for each sheet.'?

I meant when there is repeated sheets name so should put amount for the first time shows then should show amounts in the same row for first showing for each sheet as show in the picture
for instance MK sheet repeated twice then 16,330.00 will show in first time when doesn't contain item in SAFES column as marked .

Please post an XL2BB mini-sheet.

I'm not sure how show by form !

I mean having combo boxes to select the date range instead of having to type the dates into the text boxes.

if it's possible by textboxes will be great , if not then I accept by comboboxes.

 

[Fuji]

Option Explicit

Private Sub CommandButton1_Click()
    Dim myList, i&, x$, s(1 To 2)
    Me.ListBox1.Clear
    For i = 1 To 2
        x = Me("textbox" & i)
        If x <> "" Then
            If Not x Like "##/##/####" Then
                MsgBox "Date should be dd/mm/yyyy format" & vbLf & "e.g. 31/01/2025": Exit Sub
            Else
                s(i) = GetSerialDate(x)
            End If
        End If
    Next
    myList = GetList(s)
    With Me.ListBox1
        .ColumnCount = UBound(myList, 2)
        .TextAlign = 2
        If UBound(myList, 2) > 1 Then .Column = myList
    End With
End Sub

Function GetSerialDate&(s$)
    Dim x
    x = Split(s, "/")
    GetSerialDate = DateSerial(x(2), x(1), x(0))
End Function

Function GetList(d)
    Dim a, b, e, i&, ii&, n&, dic As Object
    Dim key, s, cols, col, ws, x, maxDate&, temp#
    Set dic = CreateObject("Scripting.Dictionary")
    ws = Array("MK", "MT", "MS", "ATS", "VFTY")
    ReDim tbl(UBound(ws)) As Range
    For i = 0 To UBound(tbl)
        Set tbl(i) = Sheets(ws(i)).[a1].CurrentRegion
        maxDate = Application.Max(maxDate, tbl(i).Columns(1))
    Next
    If d(2) = 0 Then d(2) = maxDate
    cols = Array("PAID", "NOT PAID", "RECEIVED", "NOT REICEVED")
    ReDim a(1 To 7, 1 To 1): n = 1
    a(1, 1) = "ITEM": a(2, 1) = "SHEET NAMES": a(3, 1) = "SAFES"
    For i = 0 To UBound(cols)
        a(i + 4, 1) = cols(i)
    Next
    For Each e In tbl
        key = Application.Match("SAFES", e.Rows(1), 0)
        s = Application.Match("CASE", e.Rows(1), 0)
        b = e.Value2: dic.RemoveAll: temp = 0
        For i = 2 To UBound(b)
            If b(i, s) <> "" Then
                If (b(i, 1) >= d(1)) * (b(i, 1) <= d(2)) Then
                    If b(i, key) = "" Then If dic.Count Then b(i, key) = dic.keys()(0)
                    If b(i, key) <> "" Then
                        If Not dic.exists(b(i, key)) Then
                            n = n + 1: dic(b(i, key)) = n
                            ReDim Preserve a(1 To 7, 1 To n): a(1, n) = n - 1
                            a(2, n) = e.Parent.Name: a(3, n) = b(i, key)
                        End If
                    End If
                    x = Application.Match(b(i, s), cols, 0)
                    If b(i, s) Like "NOT *" Then
                        col = x
                        temp = temp + b(i, UBound(b, 2))
                    Else
                        a(x + 3, dic(b(i, key))) = _
                        Format$(Val(Replace(a(x + 3, dic(b(i, key))), ",", "")) + b(i, UBound(b, 2)), "#,0.00")
                    End If
                End If
            End If
        Next
        If dic.Count Then
            If col Then a(col + 3, dic.items()(0)) = temp
            For i = dic.items()(0) To dic.items()(dic.Count - 1)
                For ii = 4 To 7
                    If (a(ii, i) = "") + (a(ii, i) = 0) Then a(ii, i) = "-"
                Next
            Next
        End If
    Next
    GetList = a
End Function

 

[Maklil]

@Fuji
this is really awesome!
I notice your code doesn't show format number in NOT PAID, NOT RECEIVED columns, may also show ,please?
also I don't know how add ColumnWidths to your code to adjustment spaces among columns in listbox, may you guide me please?

 

[Fuji]

1)

        If dic.Count Then
            If col Then a(col + 3, dic.items()(0)) = temp

        If dic.Count Then
            If col Then a(col + 3, dic.items()(0)) = Format$(temp, "#,0.00")

2)

    With Me.ListBox1
        .ColumnCount = UBound(myList, 2)
        .TextAlign = 2
        If UBound(myList, 2) > 1 Then .Column = myList
    End With

    With Me.ListBox1
        .ColumnCount = UBound(myList, 2)
        .ColumnWidths = ";;;;;;"
        .TextAlign = 2
        If UBound(myList, 2) > 1 Then .Column = myList
    End With

 

[Maklil]

Much appreciated for your help Fuji.

 

[Maklil]