Please help me with the code that integrates the data called for the listbox

saftawy1

Board Regular
Joined
Oct 12, 2021
Messages
65
Office Version
  1. 2019
  2. 2016
Platform
  1. Windows
I Use this code to bring the data to the list box. It appears as in picture 2. It is required to appear as in picture 3, where the data is merged according to the name of the product. Picture 1 contains a table format and an Excel file attachment
TEST MERGE.xlsb
N
11
kha

VBA Code:
On Error Resume Next
Application.ScreenUpdating = False
      Dim wColmn, srng As Range
Dim i As Long
Const ContColmn As Integer = 7
    Set srng = ThisWorkbook.Sheets("KHA").Range("A1").Resize(1, ContColmn)
For i = 1 To ContColmn
    With Me.Controls("Label" & i)
           .Caption = srng(i)
        wColmn = wColmn & .Width & " "
    End With
Next '1111111111111111111111111111111111
    Dim x, ws As Worksheet, j As Long, lastrow As Long
    With Me.ListBox7
        .Clear
        Set ws = ThisWorkbook.Sheets("kha")
        x = Application.Match(Me.ComboBox1.Value, ws.Rows(1), 0)
        If Not IsError(x) Then
            lastrow = ws.Cells(Rows.Count, "A").End(xlUp).Row
                        Dim a, myCols, ii As Long
            ReDim a(1 To 7, 1 To lastrow)
            myCols = Array(1, 2, 3, 4, 5, 6, 7)

            For i = 2 To lastrow
                If Me.TextBox9 <> "" And InStr(ws.Cells(i, x), Me.TextBox9) <> 0 Then
                    j = j + 1
                    For ii = 0 To UBound(myCols)
                        a(ii + 1, j) = ws.Cells(i, myCols(ii)).Value
                    Next

                End If
            Next i
            '1111111111111111111111
                        For i = 2 To lastrow
                If Me.TextBox9 = "" Then
                    j = j + 1
                    For ii = 0 To UBound(myCols)
                        a(ii + 1, j) = ws.Cells(i, myCols(ii)).Value
                    Next

                End If
            Next i
            '1111111111111111111111

            ReDim Preserve a(1 To UBound(a, 1), 1 To j)
            .Column = a
        End If
        End With
 

Attachments

  • 1.JPG
    1.JPG
    69.6 KB · Views: 8
  • 2.JPG
    2.JPG
    71 KB · Views: 8
  • 3.JPG
    3.JPG
    17.3 KB · Views: 9

Excel Facts

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

Forum statistics

Threads
1,214,908
Messages
6,122,186
Members
449,071
Latest member
cdnMech

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