Excel VBA listbox to Populate Date with criteria at User Form Initialization

qadirsyed

New Member
Joined
Mar 6, 2022
Messages
11
Office Version
  1. 2019
Platform
  1. Windows
  2. MacOS
  3. Mobile
  4. Web
Hello to all,
As you already know i am new to this forum. I am a trying to create a userform which will be used by multiple users. My form is currently working properly but I need to make a few adjustments in coding which due to my lack of knowledge im unable to. What I want is that each user should be able to see only what he enterted in the listboxt except the "ONE USER" who can see all.
the name of my User form is frmReq and current user is in textbox=txtActiveUser. Currently my form is using "rowsource" method to populate the data so it is populating the entire range.
My data sheet name is "Requisitions" and listbox name is lstdatabase. I would be highly obliged if anyone here can guide me through......

VBA Code:
Dim iRow As Long
    Dim sh As Worksheet
    Set sh = ThisWorkbook.Sheets("Privacy Page")
    Dim dsh As Worksheet
    Set dsh = ThisWorkbook.Sheets("Requisitions")
    iRow = [Counta(Requisitions!A:A)] ' idetifying the last row
    
    
        With frmReq
    
        .txtRq.Value = ""    '>>>>>> Demand Text box Clear
        .CmbCompany.Clear    '>>>>>> List in Company Clear
        
        .CmbCompany.AddItem "ABEL"
        .CmbCompany.AddItem "NAM"
        .CmbCompany.AddItem "NAMCO"
        .CmbCompany.AddItem "ANN"
        
        
        .CmbProject.Clear    '>>>>>> List in Projects Clear
        
        .CmbProject.AddItem "Water"
        .CmbProject.AddItem "A"
        .CmbProject.AddItem "B"
        .CmbProject.AddItem "C"
        .CmbProject.AddItem "D"
        

        .CmbPlant.Clear      '>>>>>> List in PLANTS Clear
        
        
        .CmbPlant.AddItem "JHANG"
        .CmbPlant.AddItem "JAHANIAN"
        .CmbPlant.AddItem "JAHANGIRA"
        .CmbPlant.AddItem "SAHIWAL"
        .CmbPlant.AddItem "PHED-I"
        .CmbPlant.AddItem "WASA-III"
        .CmbPlant.AddItem "PHED-SKP"
        .CmbPlant.AddItem "Court-Darbar Shareef"
                
        .txtDes.Value = ""
        
        .CmbAccountHd.Clear   '>>>>>> List in Account Heads Clear
        
        
        .CmbAccountHd.AddItem "Operators Salaries"
        .CmbAccountHd.AddItem "Electricity Bills"
        .CmbAccountHd.AddItem "Water Test Report"
        .CmbAccountHd.AddItem "R&M Expenses"
        .CmbAccountHd.AddItem "R& m(SBM)"
        .CmbAccountHd.AddItem "Hanzala (Technician)"
        .CmbAccountHd.AddItem "P.C.Wire 7/16 inch"
        .CmbAccountHd.AddItem "P.C.Wire 3/8 inch"
        .CmbAccountHd.AddItem "Cement"
        .CmbAccountHd.AddItem "Wire - 5mm"
        .CmbAccountHd.AddItem "F.oil"
        .CmbAccountHd.AddItem "Diesel"
        .CmbAccountHd.AddItem "Binding wire"
        .CmbAccountHd.AddItem "Welding Holder 800 amp"
        .CmbAccountHd.AddItem "Nylon Pipe for cabel 1 inch dia"
        .CmbAccountHd.AddItem "Bearing 11003 - 3534 - A"
        .CmbAccountHd.AddItem "Grips 3/8 inch with body"
        .CmbAccountHd.AddItem "Bitumen paint"
        .CmbAccountHd.AddItem "LDO"
        .CmbAccountHd.AddItem "LDO"
        .CmbAccountHd.AddItem "Gloves Cloth"
        .CmbAccountHd.AddItem "LDO"
        .CmbAccountHd.AddItem "Red Pump - Faisal"
        .CmbAccountHd.AddItem "Flang OD- 11 inch   thik-1 inch"
        .CmbAccountHd.AddItem "Gear Box: Ratio: 1-31"
        .CmbAccountHd.AddItem "Turpal 15 x 20 ft Water proof"
        .CmbAccountHd.AddItem "Cabel 7/44 Flexible 3-core"
        .CmbAccountHd.AddItem "Nylon Pipe for cabel 1 inch dia"
        .CmbAccountHd.AddItem "Cabel 7/36 Flexible 3-core"
        .CmbAccountHd.AddItem "Motor 20 HP/1450 (Techo)"
        .CmbAccountHd.AddItem "Nut with Boalt 6 inch x 6 inch half thread and with washers ( Complete Set)"
        .CmbAccountHd.AddItem "Nut Boalt 5''' x 5 inch"
        .CmbAccountHd.AddItem "Boiler Chemical"
        .CmbAccountHd.AddItem "Welding Rod - No - 10"
        .CmbAccountHd.AddItem "Grease S.T in Tin(F.Quality)"
        .CmbAccountHd.AddItem "Grease ( Low Quality )"
        .CmbAccountHd.AddItem "Breaker 150 Amp 3-P"
        .CmbAccountHd.AddItem "Grips 3/8 inch with body"
        .CmbAccountHd.AddItem "Cement Fare Charges"
        .CmbAccountHd.AddItem "Crush"
        .CmbAccountHd.AddItem "Sand"
        .CmbAccountHd.AddItem "P.C. Wire, 5mm & Steel Fare"
        .CmbAccountHd.AddItem "Light Diesel"
        .CmbAccountHd.AddItem "Diesel For Generator"
        .CmbAccountHd.AddItem "Curing Compound Fare"
        .CmbAccountHd.AddItem "Bitumen Paint (Fare only )"
        .CmbAccountHd.AddItem "Kerosene Oil"
        .CmbAccountHd.AddItem "Electricity Charges"
        .CmbAccountHd.AddItem "Labor Wages"
        .CmbAccountHd.AddItem "Staff Salary"
        .CmbAccountHd.AddItem "Repairs of Machines"
        .CmbAccountHd.AddItem "Vehicle Repair"
        .CmbAccountHd.AddItem "P.O.L"
        .CmbAccountHd.AddItem "Mess"
        .CmbAccountHd.AddItem "Entertainment"
        .CmbAccountHd.AddItem "Wooden Bally"
        .CmbAccountHd.AddItem "Miscellaneous"
        .CmbAccountHd.AddItem "T.A. & Carriage"
        .CmbAccountHd.AddItem "Taxes"
        .CmbAccountHd.AddItem "Extra Purchase(Poles)"
        .CmbAccountHd.AddItem "PC , Bills"
        .CmbAccountHd.AddItem "Poles Shifting Charges"
        .CmbAccountHd.AddItem "Other Expenses"

        
        .CmbUOM.Clear   '>>>>>> List in Unit of Measurement(UOM)Clear
        
        .CmbUOM.AddItem "Kg"
        .CmbUOM.AddItem "Ton"
        .CmbUOM.AddItem "No"
        .CmbUOM.AddItem "Ltr"
        .CmbUOM.AddItem "Pack"
        .CmbUOM.AddItem "Bag"
        .CmbUOM.AddItem "Rft"
        .CmbUOM.AddItem "Dozen"
        .CmbUOM.AddItem "Drum"
        .CmbUOM.AddItem "Tin"
        .CmbUOM.AddItem "Carton"
        .CmbUOM.AddItem "Bundle"
        .CmbUOM.AddItem "Roll"
        .CmbUOM.AddItem "Meter"
        .CmbUOM.AddItem "Other"
        
        .TxtRate.Value = ""
        .TxtQty.Value = ""
        .TxtQty2.Value = ""
        .TxtQty3.Value = ""
        .txtAmtRq.Value = ""
        .TxtApQty1.Value = ""
        .TxtApQty2.Value = ""
        .TxtApQty3.Value = ""
        .TxtAmtAp.Value = ""
        .TxtPending.Value = ""
        
        .CmbStatus.Clear                 '>>>>>>>>>> List in Approval Status Clear
    
        .CmbStatus.AddItem "Pending"
        .CmbStatus.AddItem "Approved"
        .CmbStatus.AddItem "Partial Approval"
        .CmbStatus.AddItem "Unapproved"
        

        .txtRowNumber.Value = ""
        
        '''''''''' Filter_by List
    
    With frmReq
    
    .cmb_Filter_By.Clear
 
    
    .cmb_Filter_By.AddItem "ALL"
    .cmb_Filter_By.AddItem "Demand No."
    .cmb_Filter_By.AddItem "Project"
    .cmb_Filter_By.AddItem "Company"
    .cmb_Filter_By.AddItem "Plant"
    .cmb_Filter_By.AddItem "Account Head"
    .cmb_Filter_By.AddItem "Approval Status"
    '.cmb_Filter_By.AddItem "Pending Amount"
    
    .cmb_Filter_By.Value = "ALL"


    End With

'''''''''' Sort by List
    With frmReq

    .cmb_Sort_by.Clear
    
    .cmb_Sort_by.AddItem "Sr. No."
    .cmb_Sort_by.AddItem "Demand No."
    .cmb_Sort_by.AddItem "Project"
    .cmb_Sort_by.AddItem "Company"
    .cmb_Sort_by.AddItem "Plant"
    .cmb_Sort_by.AddItem "Account Head"
    .cmb_Sort_by.AddItem "Approval Status"
    .cmb_Sort_by.AddItem "Pending Amount"
    
End With
        .lstDatabase.ColumnCount = 21
        .lstDatabase.ColumnHeads = True
        .lstDatabase.ColumnWidths = "30,55,55,55,70,150,100,35,40,40,40,52,65,45,45,45,65,70,80,90,70"
        
        If iRow > 1 Then
            .lstDatabase.RowSource = "Requisitions!A2:U" & iRow
        Else
            .lstDatabase.RowSource = "Requisitions!A2:U2"
        End If
    End With
 
I just tried to download and edit from the link, it is allowing to do so, kindly try and open in desktop app

OK got it now, will take a look when have a moment & see if can offer any suggestions to update your code

Dave
 
Upvote 0

Excel Facts

Last used cell?
Press Ctrl+End to move to what Excel thinks is the last used cell.
Dave any luck????

I have been playing with your project but it is complex & requirement to filter names based on user name not so straightforward as your listbox is populated using rowsource which, unless you copy filtered data to another sheet, need to use List property of control but this does not allow inclusion of column headers to be displayed.

There are other coding issues that also need resolving to make your project work in manner required but my time is very limited - I do have a look from time to time & if can find solution will post back but afraid will have to be a little patient or perhaps another here can take up the challenge.

Dave
 
Upvote 0
Hi,
just to let you know not forgotten this but it is a complex project & my time is limited - I would say that the more I look at it the more I am certain that you would do better to consider using Access which is a database application if it is your intention to share the workbook across your network for multiple users?
but if wish to continue with using Excel workbook just be mindful that it will only ever be a one user at time application.

I have seen your other post (Update or edit my filtered worksheet from userform) with regards to the error which I suspect is being caused because your are using RowSource to connect your listbox to the data.
Whilst I understand why you want to do this (many columns & want to display headers) using Rowsource means you have a direct connection to the range & certain operations like deleting a row will fail unless you first disconnect it

Code:
 MyListbox.RowSource = ""
'code
MyListbox.RowSource = Sheet1.Name & "!" & Sheet1.Address

In addition you cannot (as far as I am aware) use RowSource on a filtered sheet - The workaround is to copy the filtered data to another sheet & then make the connection - This approach though, throws up the problem of maintaining the data back on the master sheet as the filtered data indexing will not be same.

If I manage to find time & figure something out for you will post back but cannot promise it - meantime I would encourage you to at least have a play with Access.




Dave
 
Last edited:
Upvote 0
Hi,
just to let you know not forgotten this but it is a complex project & my time is limited - I would say that the more I look at it the more I am certain that you would do better to consider using Access which is a database application if it is your intention to share the workbook across your network for multiple users?
but if wish to continue with using Excel workbook just be mindful that it will only ever be a one user at time application.

I have seen your other post (Update or edit my filtered worksheet from userform) with regards to the error which I suspect is being caused because your are using RowSource to connect your listbox to the data.
Whilst I understand why you want to do this (many columns & want to display headers) using Rowsource means you have a direct connection to the range & certain operations like deleting a row will fail unless you first disconnect it

Code:
 MyListbox.RowSource = ""
'code
MyListbox.RowSource = Sheet1.Name & "!" & Sheet1.Address

In addition you cannot (as far as I am aware) use RowSource on a filtered sheet - The workaround is to copy the filtered data to another sheet & then make the connection - This approach though, throws up the problem of maintaining the data back on the master sheet as the filtered data indexing will not be same.

If I manage to find time & figure something out for you will post back but cannot promise it - meantime I would encourage you to at least have a play with Access.




Dave
Thanks for your response,

i some how managed to filter my listbox using the following code:

VBA Code:
Private Sub UserForm_Initialize()

Application.ScreenUpdating = False: Application.Calculation = xlCalculationAutomatic
 
Dim dsh As Worksheet
Set dsh = ThisWorkbook.Sheets("Privacy Page")
 Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Requisitions")
  
Dim rng As Range, r As Range
Dim lastrow As Long, i As Long

sh.Activate
sh.AutoFilterMode = False

Dim j As Long
If dsh.Range("H1").Value = "wahab" Or dsh.Range("H1").Value = "babar" Or _
dsh.Range("H1").Value = "naeem" Or dsh.Range("H1").Value = "zeeshan" _
Or dsh.Range("H1").Value = "khurram" Then

sh.Columns("A:U").AutoFilter Field:=19, Criteria1:=dsh.Range("H1").Value
On Error Resume Next
Else
sh.Columns("A:U").AutoFilter Field:=19
End If
    'lastrow = Cells(1, 1).End(xlDown).Row
    lastrow = Application.WorksheetFunction.CountA(sh.Range("A:A"))
    If lastrow = 1 Then lastrow = 2
    Set rng = sh.Range(sh.Cells(1, 1), sh.Cells(lastrow, 1))
    Set rng = rng.SpecialCells(xlCellTypeVisible)
    ReDim rTab(0 To rng.Count - 1, 1 To 21)
    i = 0
    For Each r In rng
        For j = 0 To 20
            rTab(i, j + 1) = r.Offset(, j)
        Next j
        i = i + 1
        Next
       Me.lstDatabase.List = rTab
   Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
    Call hide_frmreq_btns
    Call Sum_columns
    Call Reset
    frmReq.txtActiveUser = ThisWorkbook.Sheets("Privacy Page").Range("H1").Value
End Sub


but now i am having problem of editing previous filtered data and adding new to filtered listbox.
if the user "Admin" uses it it works perfect, it is the other users who have filtered listbox i am having issues with.
kindly take some time out and guide me
 
Upvote 0
Thanks for your response,

i some how managed to filter my listbox using the following code:

Yes the List property of the control is the method most use but you will not be able to display the column headings - one trick used is to place labels above the listbox to shown column names but this only works if data in the list box is all in view - your data is wide & need to scroll across so having headings in listbox makes sense - there are other tricks I have seen using two listboxes one to display the headings but not something I have tried.

Using rowsource to display the data with headings although not favoured by many, is possible (including filtered data) in cases like yours but its not simple.

Like I said, if can find time to work through your project I will post back but I personally feel you would get better results working with Access.

Dave
 
Upvote 0
Yes the List property of the control is the method most use but you will not be able to display the column headings - one trick used is to place labels above the listbox to shown column names but this only works if data in the list box is all in view - your data is wide & need to scroll across so having headings in listbox makes sense - there are other tricks I have seen using two listboxes one to display the headings but not something I have tried.

Using rowsource to display the data with headings although not favoured by many, is possible (including filtered data) in cases like yours but its not simple.

Like I said, if can find time to work through your project I will post back but I personally feel you would get better results working with Access.

Dave
Thanx for your concern but i have managed to get rest working, only this is pending, i shall be highly obliged If you kindly manage some time and sort the solution out plz
 
Upvote 0

Forum statistics

Threads
1,214,971
Messages
6,122,521
Members
449,088
Latest member
RandomExceller01

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