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

Q

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
 

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).
Sort by date Sort by votes
qadirsyed said:
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
Click to expand...


Further, I would like to add that this is internal Demand/Requisitions form
 

Attachments

  • Sheet name Requisitions.JPG
    Sheet name Requisitions.JPG
    105.8 KB · Views: 17
Upvote 0
Hi,
Its more helpful to forum if you post copy of your worksheet using MRExcel Addin XL2BB - Excel Range to BBCode

Your code does not show how the name of current user is populated to textbox txtActiveUser ?
Is the user name the same as name in Column S of your worksheet? and what name determines the "ONE USER"?

As an aside, rather than hard code all the combobox values, consider adding a worksheet with all the values listed in their own column. This will be much easier to maintain, allow you to sort values & requires just a single line of code to read the range as an array using the list property for each control.

Dave
 
Upvote 0
dmt32 said:
Hi,
Its more helpful to forum if you post copy of your worksheet using MRExcel Addin XL2BB - Excel Range to BBCode

Your code does not show how the name of current user is populated to textbox txtActiveUser ?
Is the user name the same as name in Column S of your worksheet? and what name determines the "ONE USER"?

As an aside, rather than hard code all the combobox values, consider adding a worksheet with all the values listed in their own column. This will be much easier to maintain, allow you to sort values & requires just a single line of code to read the range as an array using the list property for each control.

Dave
Click to expand...
 
Upvote 0
Thanks for your quick response! I am attaching the entire code for form. your suggestions regardinig hardcoding is highly obliged and i shall start working on it also.

the code for frmReq is as below:

VBA Code: 
Option Explicit
Private Sub cmdDelete_Click()
    If Selected_List = 0 Then
        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Delete"
        Exit Sub
    End If
    Dim i As VbMsgBoxResult
    i = MsgBox("Do you want to delete the selected record?", vbYesNo + vbQuestion, "Confirmation")
    If i = vbNo Then Exit Sub
    ThisWorkbook.Sheets("Requisitions").Rows(Selected_List + 1).Delete
    Call Reset
    MsgBox "Selected record has been deleted.", vbOKOnly + vbInformation, "Deleted"
End Sub

Private Sub cmdEdit_Click()
        If Selected_List = 0 Then
    MsgBox "No row is selected.", vbOKOnly + vbInformation, "Edit"
        Exit Sub
    End If
  
    Me.txtRowNumber.Value = Selected_List + 1
    Me.txtRq.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 1)
    Me.CmbCompany.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 2)
    Me.CmbProject.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 3)
    Me.CmbPlant.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 4)
    Me.txtDes.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 5)
    Me.CmbAccountHd.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 6)
    Me.CmbUOM.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 7)
    Me.TxtQty.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 8)
    Me.TxtQty2.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 9)
    Me.TxtQty3.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 10)
    Me.TxtRate.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 11)
    Me.txtAmtRq.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 12)
    Me.TxtApQty1.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 13)
    Me.TxtApQty2.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 14)
    Me.TxtApQty3.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 15)
    Me.TxtAmtAp.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 16)
    Me.TxtPending.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 17)
    Me.CmbStatus.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 20)
    MsgBox "Please make the required changes and click on 'Save' button to update.", vbOKOnly + vbInformation, "Edit"
End Sub

Private Sub cmdReset_Click()
    Call Reset
End Sub

Private Sub cmdSave_Click()
    Dim sh As Worksheet
    Set sh = Sheets("Requisitions")
    Dim dsh As Worksheet
    Set dsh = Sheets("Requisitions")

    Dim msgValue As VbMsgBoxResult
        
    If frmReq.txtRq.Value = "" Or frmReq.CmbCompany.Value = "" Or _
    frmReq.CmbProject.Value = "" Or frmReq.CmbPlant.Value = "" Or _
    frmReq.txtDes.Value = "" Or frmReq.CmbAccountHd.Value = "" Or frmReq.CmbUOM.Value = "" Or _
    frmReq.TxtQty.Value = "" Or frmReq.TxtQty2.Value = "" Or frmReq.TxtQty3.Value = "" Or _
    frmReq.TxtRate.Value = "" Then
    MsgBox ("Kindly fill all fields!")
    Exit Sub
    End If
    
    If frmReq.CmbStatus.Value = "" Then
    frmReq.CmbStatus.Value = "Pending"
    End If
    Call Submit
    Call Reset
    Call Refresh_Listbox
    
End Sub
Sub CalcTextBoxes()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationAutomatic

Me.txtAmtRq.Value = (Val(TxtQty) * Val(TxtRate)) + (Val(TxtQty2) * Val(TxtRate)) + (Val(TxtQty3) * Val(TxtRate))
If Me.CmbStatus.Value = "Unapproved" Then
Me.TxtAmtAp.Value = 0
Else
Me.TxtAmtAp.Value = (Val(TxtApQty1) * Val(TxtRate)) + (Val(TxtApQty2) * Val(TxtRate)) + (Val(TxtApQty3) * Val(TxtRate))
End If
If Me.CmbStatus.Value = "Approved" Or Me.CmbStatus.Value = "Unapproved" Then
Me.TxtPending.Value = 0
Else
Me.TxtPending.Value = [((Val(TxtQty) * Val(TxtRate)) + (Val(TxtQty2) * Val(TxtRate)) + (Val(TxtQty3) * Val(TxtRate)))] - [((Val(TxtApQty1) * Val(TxtRate)) + (Val(TxtApQty2) * Val(TxtRate)) + (Val(TxtApQty3) * Val(TxtRate)))]
End If
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub CmbStatus_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub CommandButton3_Click()
Call Refresh_Listbox
Call Sum_columns
End Sub

Private Sub TxtAmtAp_Change()
TxtAmtAp = Format(TxtAmtAp, "###,###,###")
End Sub
Private Sub TxtAmtAp_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub txtAmtRq_Change()
txtAmtRq = Format(txtAmtRq, "###,###,###,###")
End Sub
Private Sub txtAmtRq_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtApQty1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtApQty2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtApQty3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtPending_Change()
TxtPending = Format(TxtPending, "###,###,###,###")
End Sub
Private Sub TxtPending_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtQty_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtQty2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtQty3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub

Private Sub TxtRate_Change()
TxtRate = Format(TxtRate, "###,###,###,###")
End Sub

Private Sub TxtRate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtSumAmtAp_Change()
TxtSumAmtAp = Format(TxtSumAmtAp, "###,###,###,###/-")
End Sub
Private Sub TxtSumAmtP_Change()
TxtSumAmtP = Format(TxtSumAmtP, "###,###,###,###/-")
End Sub
Private Sub TxtSumAmtRq_Change()
TxtSumAmtRq = Format(TxtSumAmtRq, "###,###,###,###/-")
End Sub
Private Sub UserForm_Initialize()
    Call hide_frmreq_btns
    Call Sum_columns
    Call Reset
    frmReq.txtActiveUser = ThisWorkbook.Sheets("Privacy Page").Range("H1").Value
End Sub
Private Sub UserForm_Activate()

If CmbCompany.ListCount = 0 Then
Call Refresh_Listbox
End If
End Sub

Private Sub CommandButton4_Click()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Requisitions")

Dim Col_Number As Integer
Col_Number = Application.WorksheetFunction.Match(Me.cmb_Sort_by.Value, sh.Range("1:1"), 0)
sh.UsedRange.Sort key1:=sh.Cells(1, Col_Number), order1:=xlAscending, Header:=xlYes
Call Sum_columns
End Sub

Private Sub CommandButton5_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Requisitions")

Dim Col_Number As Integer
Col_Number = Application.WorksheetFunction.Match(Me.cmb_Sort_by.Value, sh.Range("1:1"), 0)

sh.UsedRange.Sort key1:=sh.Cells(1, Col_Number), order1:=xlDescending, Header:=xlYes
Call Sum_columns
End Sub

Sub Reset()
    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 = ""
        .CmbCompany.Clear
        
        .CmbCompany.AddItem "ABEL"
        .CmbCompany.AddItem "NAM"
        .CmbCompany.AddItem "NAMCO"
        
        .CmbProject.Clear
        
        .CmbProject.AddItem "Water"
        .CmbProject.AddItem "A"
        .CmbProject.AddItem "B"

        .CmbPlant.Clear
        
        
        .CmbPlant.AddItem "JHANG"
        .CmbPlant.AddItem "JAHANIAN"
        .CmbPlant.AddItem "JAHANGIRA"
                
        .txtDes.Value = ""
        
        .CmbAccountHd.Clear
        
        
        .CmbAccountHd.AddItem "Operators Salaries"
        .CmbAccountHd.AddItem "Electricity Bills"
        .CmbAccountHd.AddItem "Water Test Report"

        
        .CmbUOM.Clear
        
        .CmbUOM.AddItem "Kg"
        .CmbUOM.AddItem "Ton"
        .CmbUOM.AddItem "No"
        
        
        .TxtRate.Value = ""
        .TxtQty.Value = ""
        .TxtQty2.Value = ""
        .TxtQty3.Value = ""
        .txtAmtRq.Value = ""
        .TxtApQty1.Value = ""
        .TxtApQty2.Value = ""
        .TxtApQty3.Value = ""
        .TxtAmtAp.Value = ""
        .TxtPending.Value = ""
        
        .CmbStatus.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.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


End Sub

Sub Submit()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
    
    'Dim dsh As Worksheet
    'Set dsh = Sheets("Requisitions")
 
    Dim sh As Worksheet
    Dim iRow As Long
    
    Set sh = ThisWorkbook.Sheets("Requisitions")
    
    If frmReq.txtRowNumber.Value = "" Then
    
        iRow = [Counta(Requisitions!A:A)] + 1
    Else
    
        iRow = frmReq.txtRowNumber.Value
        
    End If
    
    If sh.Cells(iRow, 19) = "" Or sh.Cells(iRow, 20) = "" Then
        With sh
    
        .Cells(iRow, 1) = iRow - 1
        .Cells(iRow, 2) = frmReq.txtRq.Value
        .Cells(iRow, 3) = frmReq.CmbCompany.Value
        .Cells(iRow, 4) = frmReq.CmbProject.Value
        .Cells(iRow, 5) = frmReq.CmbPlant.Value
        .Cells(iRow, 6) = frmReq.txtDes.Value
        .Cells(iRow, 7) = frmReq.CmbAccountHd.Value
        .Cells(iRow, 8) = frmReq.CmbUOM.Value
        .Cells(iRow, 9) = frmReq.TxtQty.Value
        .Cells(iRow, 10) = frmReq.TxtQty2.Value
        .Cells(iRow, 11) = frmReq.TxtQty3.Value
        .Cells(iRow, 12) = frmReq.TxtRate.Value
        .Cells(iRow, 13) = frmReq.txtAmtRq.Value
        .Cells(iRow, 14) = frmReq.TxtApQty1.Value
        .Cells(iRow, 15) = frmReq.TxtApQty2.Value
        .Cells(iRow, 16) = frmReq.TxtApQty3.Value
        .Cells(iRow, 17) = frmReq.TxtAmtAp.Value
        .Cells(iRow, 18) = frmReq.TxtPending.Value
        .Cells(iRow, 19) = frmReq.txtActiveUser.Value
        '.Cells(iRow, 19) = ThisWorkbook.Sheets("Privacy Page").Range("H1").Value
        'Application.UserName
        .Cells(iRow, 20) = [Text(Now(), "DD-MM-YYYY HH:MM:SS")]
        .Cells(iRow, 21) = frmReq.CmbStatus.Value
        End With
        Else
        
        With sh
        .Cells(iRow, 1) = iRow - 1
        .Cells(iRow, 2) = frmReq.txtRq.Value
        .Cells(iRow, 3) = frmReq.CmbCompany.Value
        .Cells(iRow, 4) = frmReq.CmbProject.Value
        .Cells(iRow, 5) = frmReq.CmbPlant.Value
        .Cells(iRow, 6) = frmReq.txtDes.Value
        .Cells(iRow, 7) = frmReq.CmbAccountHd.Value
        .Cells(iRow, 8) = frmReq.CmbUOM.Value
        .Cells(iRow, 9) = frmReq.TxtQty.Value
        .Cells(iRow, 10) = frmReq.TxtQty2.Value
        .Cells(iRow, 11) = frmReq.TxtQty3.Value
        .Cells(iRow, 12) = frmReq.TxtRate.Value
        .Cells(iRow, 13) = frmReq.txtAmtRq.Value
        .Cells(iRow, 14) = frmReq.TxtApQty1.Value
        .Cells(iRow, 15) = frmReq.TxtApQty2.Value
        .Cells(iRow, 16) = frmReq.TxtApQty3.Value
        .Cells(iRow, 17) = frmReq.TxtAmtAp.Value
        .Cells(iRow, 18) = frmReq.TxtPending.Value
        .Cells(iRow, 21) = frmReq.CmbStatus.Value
        End With
        
    End If
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

Function Selected_List() As Long                 '>>>>used in Edit

    Dim i As Long
    Selected_List = 0
    For i = 0 To frmReq.lstDatabase.ListCount - 1
        If frmReq.lstDatabase.Selected(i) = True Then
            Selected_List = i + 1
            Exit For
        End If
    Next i
End Function

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<
Sub Refresh_DropDown_List()
End Sub

Sub Refresh_Listbox()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Requisitions")
 
Dim dsh As Worksheet
Set dsh = ThisWorkbook.Sheets("Req_Display")

''''''''''' Copy Data ''''''''''
dsh.Cells.Clear
sh.AutoFilterMode = False

If Me.cmb_Filter_By.Value <> "ALL" Then
sh.UsedRange.AutoFilter Application.WorksheetFunction.Match(Me.cmb_Filter_By.Value, sh.Range("1:1"), 0), "*" & frmReq.txt_Search.Value & "*"
End If

sh.UsedRange.Copy dsh.Range("A1")
sh.AutoFilterMode = False
Dim lr As Long
lr = Application.WorksheetFunction.CountA(dsh.Range("A:A"))
If lr = 1 Then lr = 2


With Me.lstDatabase
    
    .ColumnHeads = True
    .ColumnCount = 21
    .ColumnWidths = "30,55,55,55,70,150,100,35,40,40,40,52,65,45,45,45,65,70,80,90,70"
    .RowSource = "Req_Display!A2:U" & lr
    End With
 
End Sub



VBA Code: 
Option Private Module
Option Explicit
Sub Sum_columns()
On Error Resume Next
Dim sum1 As Double
Dim sum2 As Double
Dim sum3 As Double
Dim r As Integer
sum1 = 0
sum2 = 0
sum3 = 0
With frmReq.lstDatabase
For r = 0 To .ListCount - 1
sum1 = sum1 + .List(r, 12)
sum2 = sum2 + .List(r, 16)
sum3 = sum3 + .List(r, 17)
Next r
End With
frmReq.TxtSumAmtRq.Value = sum1
frmReq.TxtSumAmtAp.Value = sum2
frmReq.TxtSumAmtP.Value = sum3
End Sub
 
Upvote 0
qadirsyed said:
Thanks for your quick response! I am attaching the entire code for form. your suggestions regardinig hardcoding is highly obliged and i shall start working on it also.

the code for frmReq is as below:

VBA Code: 
Option Explicit
Private Sub cmdDelete_Click()
    If Selected_List = 0 Then
        MsgBox "No row is selected.", vbOKOnly + vbInformation, "Delete"
        Exit Sub
    End If
    Dim i As VbMsgBoxResult
    i = MsgBox("Do you want to delete the selected record?", vbYesNo + vbQuestion, "Confirmation")
    If i = vbNo Then Exit Sub
    ThisWorkbook.Sheets("Requisitions").Rows(Selected_List + 1).Delete
    Call Reset
    MsgBox "Selected record has been deleted.", vbOKOnly + vbInformation, "Deleted"
End Sub

Private Sub cmdEdit_Click()
        If Selected_List = 0 Then
    MsgBox "No row is selected.", vbOKOnly + vbInformation, "Edit"
        Exit Sub
    End If
 
    Me.txtRowNumber.Value = Selected_List + 1
    Me.txtRq.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 1)
    Me.CmbCompany.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 2)
    Me.CmbProject.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 3)
    Me.CmbPlant.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 4)
    Me.txtDes.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 5)
    Me.CmbAccountHd.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 6)
    Me.CmbUOM.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 7)
    Me.TxtQty.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 8)
    Me.TxtQty2.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 9)
    Me.TxtQty3.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 10)
    Me.TxtRate.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 11)
    Me.txtAmtRq.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 12)
    Me.TxtApQty1.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 13)
    Me.TxtApQty2.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 14)
    Me.TxtApQty3.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 15)
    Me.TxtAmtAp.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 16)
    Me.TxtPending.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 17)
    Me.CmbStatus.Value = Me.lstDatabase.List(Me.lstDatabase.ListIndex, 20)
    MsgBox "Please make the required changes and click on 'Save' button to update.", vbOKOnly + vbInformation, "Edit"
End Sub

Private Sub cmdReset_Click()
    Call Reset
End Sub

Private Sub cmdSave_Click()
    Dim sh As Worksheet
    Set sh = Sheets("Requisitions")
    Dim dsh As Worksheet
    Set dsh = Sheets("Requisitions")

    Dim msgValue As VbMsgBoxResult
       
    If frmReq.txtRq.Value = "" Or frmReq.CmbCompany.Value = "" Or _
    frmReq.CmbProject.Value = "" Or frmReq.CmbPlant.Value = "" Or _
    frmReq.txtDes.Value = "" Or frmReq.CmbAccountHd.Value = "" Or frmReq.CmbUOM.Value = "" Or _
    frmReq.TxtQty.Value = "" Or frmReq.TxtQty2.Value = "" Or frmReq.TxtQty3.Value = "" Or _
    frmReq.TxtRate.Value = "" Then
    MsgBox ("Kindly fill all fields!")
    Exit Sub
    End If
   
    If frmReq.CmbStatus.Value = "" Then
    frmReq.CmbStatus.Value = "Pending"
    End If
    Call Submit
    Call Reset
    Call Refresh_Listbox
   
End Sub
Sub CalcTextBoxes()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationAutomatic

Me.txtAmtRq.Value = (Val(TxtQty) * Val(TxtRate)) + (Val(TxtQty2) * Val(TxtRate)) + (Val(TxtQty3) * Val(TxtRate))
If Me.CmbStatus.Value = "Unapproved" Then
Me.TxtAmtAp.Value = 0
Else
Me.TxtAmtAp.Value = (Val(TxtApQty1) * Val(TxtRate)) + (Val(TxtApQty2) * Val(TxtRate)) + (Val(TxtApQty3) * Val(TxtRate))
End If
If Me.CmbStatus.Value = "Approved" Or Me.CmbStatus.Value = "Unapproved" Then
Me.TxtPending.Value = 0
Else
Me.TxtPending.Value = [((Val(TxtQty) * Val(TxtRate)) + (Val(TxtQty2) * Val(TxtRate)) + (Val(TxtQty3) * Val(TxtRate)))] - [((Val(TxtApQty1) * Val(TxtRate)) + (Val(TxtApQty2) * Val(TxtRate)) + (Val(TxtApQty3) * Val(TxtRate)))]
End If
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub
Private Sub CmbStatus_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub CommandButton3_Click()
Call Refresh_Listbox
Call Sum_columns
End Sub

Private Sub TxtAmtAp_Change()
TxtAmtAp = Format(TxtAmtAp, "###,###,###")
End Sub
Private Sub TxtAmtAp_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub txtAmtRq_Change()
txtAmtRq = Format(txtAmtRq, "###,###,###,###")
End Sub
Private Sub txtAmtRq_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtApQty1_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtApQty2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtApQty3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtPending_Change()
TxtPending = Format(TxtPending, "###,###,###,###")
End Sub
Private Sub TxtPending_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtQty_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtQty2_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtQty3_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub

Private Sub TxtRate_Change()
TxtRate = Format(TxtRate, "###,###,###,###")
End Sub

Private Sub TxtRate_Exit(ByVal Cancel As MSForms.ReturnBoolean)
Call CalcTextBoxes
End Sub
Private Sub TxtSumAmtAp_Change()
TxtSumAmtAp = Format(TxtSumAmtAp, "###,###,###,###/-")
End Sub
Private Sub TxtSumAmtP_Change()
TxtSumAmtP = Format(TxtSumAmtP, "###,###,###,###/-")
End Sub
Private Sub TxtSumAmtRq_Change()
TxtSumAmtRq = Format(TxtSumAmtRq, "###,###,###,###/-")
End Sub
Private Sub UserForm_Initialize()
    Call hide_frmreq_btns
    Call Sum_columns
    Call Reset
    frmReq.txtActiveUser = ThisWorkbook.Sheets("Privacy Page").Range("H1").Value
End Sub
Private Sub UserForm_Activate()

If CmbCompany.ListCount = 0 Then
Call Refresh_Listbox
End If
End Sub

Private Sub CommandButton4_Click()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Requisitions")

Dim Col_Number As Integer
Col_Number = Application.WorksheetFunction.Match(Me.cmb_Sort_by.Value, sh.Range("1:1"), 0)
sh.UsedRange.Sort key1:=sh.Cells(1, Col_Number), order1:=xlAscending, Header:=xlYes
Call Sum_columns
End Sub

Private Sub CommandButton5_Click()
Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Requisitions")

Dim Col_Number As Integer
Col_Number = Application.WorksheetFunction.Match(Me.cmb_Sort_by.Value, sh.Range("1:1"), 0)

sh.UsedRange.Sort key1:=sh.Cells(1, Col_Number), order1:=xlDescending, Header:=xlYes
Call Sum_columns
End Sub

Sub Reset()
    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 = ""
        .CmbCompany.Clear
       
        .CmbCompany.AddItem "ABEL"
        .CmbCompany.AddItem "NAM"
        .CmbCompany.AddItem "NAMCO"
       
        .CmbProject.Clear
       
        .CmbProject.AddItem "Water"
        .CmbProject.AddItem "A"
        .CmbProject.AddItem "B"

        .CmbPlant.Clear
       
       
        .CmbPlant.AddItem "JHANG"
        .CmbPlant.AddItem "JAHANIAN"
        .CmbPlant.AddItem "JAHANGIRA"
               
        .txtDes.Value = ""
       
        .CmbAccountHd.Clear
       
       
        .CmbAccountHd.AddItem "Operators Salaries"
        .CmbAccountHd.AddItem "Electricity Bills"
        .CmbAccountHd.AddItem "Water Test Report"

       
        .CmbUOM.Clear
       
        .CmbUOM.AddItem "Kg"
        .CmbUOM.AddItem "Ton"
        .CmbUOM.AddItem "No"
       
       
        .TxtRate.Value = ""
        .TxtQty.Value = ""
        .TxtQty2.Value = ""
        .TxtQty3.Value = ""
        .txtAmtRq.Value = ""
        .TxtApQty1.Value = ""
        .TxtApQty2.Value = ""
        .TxtApQty3.Value = ""
        .TxtAmtAp.Value = ""
        .TxtPending.Value = ""
       
        .CmbStatus.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.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


End Sub

Sub Submit()
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual
   
    'Dim dsh As Worksheet
    'Set dsh = Sheets("Requisitions")
 
    Dim sh As Worksheet
    Dim iRow As Long
   
    Set sh = ThisWorkbook.Sheets("Requisitions")
   
    If frmReq.txtRowNumber.Value = "" Then
   
        iRow = [Counta(Requisitions!A:A)] + 1
    Else
   
        iRow = frmReq.txtRowNumber.Value
       
    End If
   
    If sh.Cells(iRow, 19) = "" Or sh.Cells(iRow, 20) = "" Then
        With sh
   
        .Cells(iRow, 1) = iRow - 1
        .Cells(iRow, 2) = frmReq.txtRq.Value
        .Cells(iRow, 3) = frmReq.CmbCompany.Value
        .Cells(iRow, 4) = frmReq.CmbProject.Value
        .Cells(iRow, 5) = frmReq.CmbPlant.Value
        .Cells(iRow, 6) = frmReq.txtDes.Value
        .Cells(iRow, 7) = frmReq.CmbAccountHd.Value
        .Cells(iRow, 8) = frmReq.CmbUOM.Value
        .Cells(iRow, 9) = frmReq.TxtQty.Value
        .Cells(iRow, 10) = frmReq.TxtQty2.Value
        .Cells(iRow, 11) = frmReq.TxtQty3.Value
        .Cells(iRow, 12) = frmReq.TxtRate.Value
        .Cells(iRow, 13) = frmReq.txtAmtRq.Value
        .Cells(iRow, 14) = frmReq.TxtApQty1.Value
        .Cells(iRow, 15) = frmReq.TxtApQty2.Value
        .Cells(iRow, 16) = frmReq.TxtApQty3.Value
        .Cells(iRow, 17) = frmReq.TxtAmtAp.Value
        .Cells(iRow, 18) = frmReq.TxtPending.Value
        .Cells(iRow, 19) = frmReq.txtActiveUser.Value
        '.Cells(iRow, 19) = ThisWorkbook.Sheets("Privacy Page").Range("H1").Value
        'Application.UserName
        .Cells(iRow, 20) = [Text(Now(), "DD-MM-YYYY HH:MM:SS")]
        .Cells(iRow, 21) = frmReq.CmbStatus.Value
        End With
        Else
       
        With sh
        .Cells(iRow, 1) = iRow - 1
        .Cells(iRow, 2) = frmReq.txtRq.Value
        .Cells(iRow, 3) = frmReq.CmbCompany.Value
        .Cells(iRow, 4) = frmReq.CmbProject.Value
        .Cells(iRow, 5) = frmReq.CmbPlant.Value
        .Cells(iRow, 6) = frmReq.txtDes.Value
        .Cells(iRow, 7) = frmReq.CmbAccountHd.Value
        .Cells(iRow, 8) = frmReq.CmbUOM.Value
        .Cells(iRow, 9) = frmReq.TxtQty.Value
        .Cells(iRow, 10) = frmReq.TxtQty2.Value
        .Cells(iRow, 11) = frmReq.TxtQty3.Value
        .Cells(iRow, 12) = frmReq.TxtRate.Value
        .Cells(iRow, 13) = frmReq.txtAmtRq.Value
        .Cells(iRow, 14) = frmReq.TxtApQty1.Value
        .Cells(iRow, 15) = frmReq.TxtApQty2.Value
        .Cells(iRow, 16) = frmReq.TxtApQty3.Value
        .Cells(iRow, 17) = frmReq.TxtAmtAp.Value
        .Cells(iRow, 18) = frmReq.TxtPending.Value
        .Cells(iRow, 21) = frmReq.CmbStatus.Value
        End With
       
    End If
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
End Sub

Function Selected_List() As Long                 '>>>>used in Edit

    Dim i As Long
    Selected_List = 0
    For i = 0 To frmReq.lstDatabase.ListCount - 1
        If frmReq.lstDatabase.Selected(i) = True Then
            Selected_List = i + 1
            Exit For
        End If
    Next i
End Function

'>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>><<<<<<<<<<<<<<<<<<<<<<<<<<<
Sub Refresh_DropDown_List()
End Sub

Sub Refresh_Listbox()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Requisitions")
 
Dim dsh As Worksheet
Set dsh = ThisWorkbook.Sheets("Req_Display")

''''''''''' Copy Data ''''''''''
dsh.Cells.Clear
sh.AutoFilterMode = False

If Me.cmb_Filter_By.Value <> "ALL" Then
sh.UsedRange.AutoFilter Application.WorksheetFunction.Match(Me.cmb_Filter_By.Value, sh.Range("1:1"), 0), "*" & frmReq.txt_Search.Value & "*"
End If

sh.UsedRange.Copy dsh.Range("A1")
sh.AutoFilterMode = False
Dim lr As Long
lr = Application.WorksheetFunction.CountA(dsh.Range("A:A"))
If lr = 1 Then lr = 2


With Me.lstDatabase
   
    .ColumnHeads = True
    .ColumnCount = 21
    .ColumnWidths = "30,55,55,55,70,150,100,35,40,40,40,52,65,45,45,45,65,70,80,90,70"
    .RowSource = "Req_Display!A2:U" & lr
    End With
 
End Sub



VBA Code: 
Option Private Module
Option Explicit
Sub Sum_columns()
On Error Resume Next
Dim sum1 As Double
Dim sum2 As Double
Dim sum3 As Double
Dim r As Integer
sum1 = 0
sum2 = 0
sum3 = 0
With frmReq.lstDatabase
For r = 0 To .ListCount - 1
sum1 = sum1 + .List(r, 12)
sum2 = sum2 + .List(r, 16)
sum3 = sum3 + .List(r, 17)
Next r
End With
frmReq.TxtSumAmtRq.Value = sum1
frmReq.TxtSumAmtAp.Value = sum2
frmReq.TxtSumAmtP.Value = sum3
End Sub
Click to expand...
 

Attachments

  • demo_sheet.JPG
    demo_sheet.JPG
    84.1 KB · Views: 17
  • frmReq.JPG
    frmReq.JPG
    138.1 KB · Views: 17
  • Req_Display sheet.JPG
    Req_Display sheet.JPG
    124 KB · Views: 17
Upvote 0
Hi,
project is clearly very complex - are you able to place copy of your workbook with dummy data in a file sharing site like dropbox & provide a link to it here?

Also, do try & use MrExcel addin mentioned in #post 2 when sharing worksheets on forum.

Dave
 
Upvote 0
dmt32 said:
Hi,
project is clearly very complex - are you able to place copy of your workbook with dummy data in a file sharing site like dropbox & provide a link to it here?

Also, do try & use MrExcel addin mentioned in #post 2 when sharing worksheets on forum.

Dave
Click to expand...
Dear Dave,

I tried to install the addin but my system administrator some how blocks it.
here is the link to onedrive plz. and thanks again for your quick response.

1drv.ms

Demo.xlsm

Microsoft Excel Workbook
1drv.ms
 
Upvote 0
file only allows viewing - need to be able to download a copy

Dave
 
Upvote 0
dmt32 said:
file only allows viewing - need to be able to download a copy

Dave
Click to expand...
I just tried to download and edit from the link, it is allowing to do so, kindly try and open in desktop app
 
Upvote 0
You must log in or register to reply here.

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

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