vba userform listbox with key search from 2 big table then update data with another userform

nam911

New Member
Joined
Aug 30, 2019
Messages
4
Dear member,


I try to make key search then get from 2 tables in "data entry" in to listbox as pix below
Sorry I don't know how to show my pix here
https://drive.google.com/file/d/1pnGzR1oUdX1KvCq_yUxBJrTC2jKnmtXS/view?usp=sharing

It work perfect for me 1 search but I do the same 100 times for 2 search and I got only the header
https://drive.google.com/file/d/13KaCWbQj3ydqg8sZzEiAiovBr7C8zUpq/view?usp=sharing

and please kindly correct my vba code following

Code:
Private Sub cmdSSearch_Click()


Me.cbxASearch.Value = ""


Me.Width = 800
Me.LbxSearch.Width = 760
Me.LSearch2.Width = 20


Dim h As Long


Me.LbxSearch.Clear
Me.LSearch2.Clear


'for column header
With Me.LbxSearch
    .AddItem
    
    .List(0, 0) = Sheets("Data entry").Cells(10, 27)
    .List(0, 1) = Sheets("Data entry").Cells(10, 28)
    .List(0, 2) = Sheets("Data entry").Cells(10, 32)
    .List(0, 3) = Sheets("Data entry").Cells(10, 33)
    .List(0, 4) = Sheets("Data entry").Cells(10, 34)
    .List(0, 5) = Sheets("Data entry").Cells(10, 35)
    .List(0, 6) = Sheets("Data entry").Cells(10, 36)
    .List(0, 7) = Sheets("Data entry").Cells(10, 37)
    .List(0, 8) = Sheets("Data entry").Cells(10, 44)
    .List(0, 9) = Sheets("Data entry").Cells(10, 46)
    
    .ColumnWidths = "50,100,100,100,70,70,30,30,50,0"
    .ColumnCount = 10
    .Selected(0) = True
  
End With
With Me.LSearch2
    .AddItem
    
    .List(0, 0) = Sheets("Data entry").Cells(10, 29)
    .List(0, 1) = Sheets("Data entry").Cells(10, 30)
    .List(0, 2) = Sheets("Data entry").Cells(10, 31)
    .List(0, 3) = Sheets("Data entry").Cells(10, 38)
    .List(0, 4) = Sheets("Data entry").Cells(10, 39)
    .List(0, 5) = Sheets("Data entry").Cells(10, 40)
    .List(0, 6) = Sheets("Data entry").Cells(10, 41)
    .List(0, 7) = Sheets("Data entry").Cells(10, 45)
    .List(0, 8) = Sheets("Data entry").Cells(10, 46)
    
    
    .ColumnWidths = "0,0,0,0,0,0,0,0,0,0"
    .ColumnCount = 10
    .Selected(0) = True
  
End With


'for listbox fill
On Error Resume Next
For h = 2 To Sheets("Data entry").Range("AA10000").End(xlUp).Offset(1, 0).Row
For i = 1 To 20
S = Application.WorksheetFunction.CountIf(Sheets("Data entry").Range("AA" & h, "AT" & h), Sheets("Data entry").Cells(h, i))
If S = 1 And Sheets("Data entry").Cells(h, i) = Me.cbxSSearch.Value Then
Me.LbxSearch.AddItem


Me.LbxSearch.List(LbxSearch.ListCount - 1, 0) = Sheets("Data entry").Cells(h, 27)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 1) = Sheets("Data entry").Cells(h, 28)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 2) = Sheets("Data entry").Cells(h, 32)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 3) = Sheets("Data entry").Cells(h, 33)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 4) = Sheets("Data entry").Cells(h, 34)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 5) = Sheets("Data entry").Cells(h, 35)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 6) = Sheets("Data entry").Cells(h, 36)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 7) = Sheets("Data entry").Cells(h, 37)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 8) = Sheets("Data entry").Cells(h, 44)
Me.LbxSearch.List(LbxSearch.ListCount - 1, 9) = Sheets("Data entry").Cells(h, 46)


Me.LSearch2.AddItem


Me.LSearch2.List(LSearch2.ListCount - 1, 0) = Sheets("Data entry").Cells(h, 29)
Me.LSearch2.List(LSearch2.ListCount - 1, 1) = Sheets("Data entry").Cells(h, 30)
Me.LSearch2.List(LSearch2.ListCount - 1, 2) = Sheets("Data entry").Cells(h, 31)
Me.LSearch2.List(LSearch2.ListCount - 1, 3) = Sheets("Data entry").Cells(h, 38)
Me.LSearch2.List(LSearch2.ListCount - 1, 4) = Sheets("Data entry").Cells(h, 39)
Me.LSearch2.List(LSearch2.ListCount - 1, 5) = Sheets("Data entry").Cells(h, 40)
Me.LSearch2.List(LSearch2.ListCount - 1, 6) = Sheets("Data entry").Cells(h, 41)
Me.LSearch2.List(LSearch2.ListCount - 1, 7) = Sheets("Data entry").Cells(h, 45)
Me.LSearch2.List(LSearch2.ListCount - 1, 8) = Sheets("Data entry").Cells(h, 46)


End If


Next i
Next h








End Sub
And I also have another question after this. please help!!!
 
Last edited by a moderator:

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Forum statistics

Threads
1,223,888
Messages
6,175,205
Members
452,618
Latest member
Tam84

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