Autofilter code based on username

A

aabrazil1

New Member
Joined
Feb 11, 2024
Messages
19
Office Version
  1. 2021
Platform
  1. Windows
Hello All,

I like to only show entries the user inputs in the database below. Each line has username. Below is my code. Also below is code to autofilter by user name found this forum. Where do I add the code? Any other pointers to get me started is much appreciated.

1707784414299.png


Form Code (mine):

VBA Code: 
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("Database").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   
    'Code to update the value to respective controls
    Dim sPR As String
    Me.txtRowNumber.Value = Selected_List + 1
    Me.txtnumber.Value = Me.lbdatabase.List(Me.lbdatabase.ListIndex, 1)
    Me.Txttitle.Value = Me.lbdatabase.List(Me.lbdatabase.ListIndex, 2)    
    Me.lbsystem.Value = Me.lbdatabase.List(Me.lbdatabase.ListIndex, 3)   
    sPR = Me.lbdatabase.List(Me.lbdatabase.ListIndex, 4)
    If sPR = "Y" Then
        Me.optyes.Value = True
    Else
        Me.optno.Value = True
    End If      
    Me.lbdefectcode.Value = Me.lbdatabase.List(Me.lbdatabase.ListIndex, 5)
    Me.lbexpected.Value = Me.lbdatabase.List(Me.lbdatabase.ListIndex, 6)
    Me.lbactual.Value = Me.lbdatabase.List(Me.lbdatabase.ListIndex, 7)
    Me.txtproblem.Value = Me.lbdatabase.List(Me.lbdatabase.ListIndex, 8)
    Me.txtnotes.Value = Me.lbdatabase.List(Me.lbdatabase.ListIndex, 9)
    MsgBox "Please make the required changes and click on 'Save' button to update.", vbOKOnly + vbInformation, "Edit"
End Sub

Private Sub cmdReset_Click()
    Dim msgValue As VbMsgBoxResult
   msgValue = MsgBox("Do you want to rerest the form?", vbYesNo + vbInformation, "Confirmation")
   If msgValue = vbNo Then Exit Sub
    Call Reset
End Sub

Private Sub cmdSave_Click()
   Dim msgValue As VbMsgBoxResult
   msgValue = MsgBox("Please check you entries and confirm you want to save the data", vbYesNo + vbInformation, "Confirmation")
   If msgValue = vbNo Then Exit Sub 
    Call Submit
    Call Reset
End Sub

Private Sub UserForm_Initialize()
    Call Reset
End Sub

Macro Code (mine):

VBA Code: 
Sub Reset()
    Dim iRow As Long
        iRow = [Counta(Database!A:A)] 'identifying the last row'
    With frmform1    
        .txtnumber.Value = " "
        .Txttitle.Value = " "
        .lbsystem.Clear
          .lbsystem.AddItem "ACS"
        .lbsystem.AddItem "Archive Data"
         .lbsystem.AddItem "ATDS"
        .lbsystem.AddItem "Autocapture Testbed"
         .lbsystem.AddItem "AVN"
        .lbsystem.AddItem "C&DH"
         .lbsystem.AddItem "CBS"
        .lbsystem.AddItem "COMLIDAR"
         .lbsystem.AddItem "COMM"
        .lbsystem.AddItem "COMSEC"
         .lbsystem.AddItem "EGSE"
        .lbsystem.AddItem "EGSE (Flight I&T)"
         .lbsystem.AddItem "EPS"
        .lbsystem.AddItem "FlatSat"
         .lbsystem.AddItem "FSW"
        .lbsystem.AddItem "HFCS"
         .lbsystem.AddItem "L7 Mockups (Flight I&T)"
        .lbsystem.AddItem "Landsat 7"
         .lbsystem.AddItem "LIDAR"
        .lbsystem.AddItem "MECH"
         .lbsystem.AddItem "MGSE (Flight I&T)"
        .lbsystem.AddItem "PCC"
         .lbsystem.AddItem "PROP"
        .lbsystem.AddItem "PSU"
         .lbsystem.AddItem "PTS"
        .lbsystem.AddItem "RDT"
         .lbsystem.AddItem "REU"
        .lbsystem.AddItem "ROBOT"
         .lbsystem.AddItem "RPO"
        .lbsystem.AddItem "RPO Testbed"
         .lbsystem.AddItem "SC"
        .lbsystem.AddItem "SCTHRM"
         .lbsystem.AddItem "Servicing Payload (PYLD)"
        .lbsystem.AddItem "Serviving Testbed"
         .lbsystem.AddItem "Simulators"
        .lbsystem.AddItem "SP/SV/SC SPIDER GSE"
        .lbsystem.AddItem "Spave Vehicle Management"
        .lbsystem.AddItem "SPIDER"
         .lbsystem.AddItem "SPINT"
        .lbsystem.AddItem "STR"
         .lbsystem.AddItem "SVINT"
        .lbsystem.AddItem "Testbeds"
         .lbsystem.AddItem "THRM"
        .lbsystem.AddItem "TOOL"
        .lbsystem.AddItem "VDSU"
        .lbsystem.AddItem "VSS"
        .optyes.Value = False
        .optno.Value = False
        .lbdefectcode.Clear
            .lbdefectcode.AddItem "10 - Solder Defect"
        .lbdefectcode.AddItem "20 - Contamination"
          .lbdefectcode.AddItem "30 - Shrink Tubing Missing"
        .lbdefectcode.AddItem "40 - Not Built to Specification/Drawing"
          .lbdefectcode.AddItem "50 - Dimensions Out of Tolerance"
        .lbdefectcode.AddItem "60 - Failed Test"
          .lbdefectcode.AddItem "70 - Accept"
        .lbdefectcode.AddItem "80 - Damaged"
          .lbdefectcode.AddItem "90 - Documentation Error"
        .lbexpected.Clear
          .lbexpected.AddItem ".5"
        .lbexpected.AddItem "1"
        .lbexpected.AddItem "1.5"
        .lbexpected.AddItem "2"
           .lbexpected.AddItem "2.5"
        .lbexpected.AddItem "3"
        .lbexpected.AddItem "3.5"
        .lbexpected.AddItem "4"
           .lbexpected.AddItem "4.5"
        .lbexpected.AddItem "5"
        .lbexpected.AddItem "5.5"
        .lbexpected.AddItem "6"
           .lbexpected.AddItem "6.5"
        .lbexpected.AddItem "7"
        .lbexpected.AddItem "7.5"
        .lbexpected.AddItem "8"
        .lbexpected.AddItem "8.5"
        .lbexpected.AddItem "9"
        .lbexpected.AddItem "9.5"
        .lbexpected.AddItem "10"
        .lbexpected.AddItem "10.5"
        .lbexpected.AddItem "11"
        .lbexpected.AddItem "11.5"
        .lbexpected.AddItem "12"        
        .lbactual.Clear
         .lbactual.AddItem ".5"
        .lbactual.AddItem "1"
        .lbactual.AddItem "1.5"
        .lbactual.AddItem "2"
           .lbactual.AddItem "2.5"
        .lbactual.AddItem "3"
        .lbactual.AddItem "3.5"
        .lbactual.AddItem "4"
           .lbactual.AddItem "4.5"
        .lbactual.AddItem "5"
        .lbactual.AddItem "5.5"
        .lbactual.AddItem "6"
           .lbactual.AddItem "6.5"
        .lbactual.AddItem "7"
        .lbactual.AddItem "7.5"
        .lbactual.AddItem "8"
        .lbactual.AddItem "8.5"
        .lbactual.AddItem "9"
        .lbactual.AddItem "9.5"
        .lbactual.AddItem "10"
        .lbactual.AddItem "10.5"
        .lbactual.AddItem "11"
        .lbactual.AddItem "11.5"
        .lbactual.AddItem "12"        
        .txtproblem.Value = " "
        .txtnotes.Value = " "
        .txtRowNumber.Value = " "
        .lbdatabase.ColumnCount = 12
        .lbdatabase.ColumnHeads = True
        .lbdatabase.ColumnWidths = "40,70,55,55,20,20,40,40,40,40,40,40"
        If iRow > 1 Then
            .lbdatabase.RowSource = "Database!A2:L" & iRow
        Else
            .lbdatabase.RowSource = "Database!A2:L2"
        End If
    End With
End Sub

Sub Submit()
    Dim sh As Worksheet
    Dim iRow As Long
    Set sh = ThisWorkbook.Sheets("Database")
    If frmform1.txtRowNumber.Value = " " Then   
    iRow = [Counta(Database!A:A)] + 1
    Else
    iRow = frmform1.txtRowNumber.Value
    End If
    With sh
        .Cells(iRow, 1) = iRow - 1
        .Cells(iRow, 2) = frmform1.txtnumber.Value
        .Cells(iRow, 3) = frmform1.Txttitle.Value
        .Cells(iRow, 4) = frmform1.lbsystem.Value
        .Cells(iRow, 5) = IIf(frmform1.optyes.Value = True, "Y", "N")
        .Cells(iRow, 6) = frmform1.lbdefectcode.Value
        .Cells(iRow, 7) = frmform1.lbexpected.Value
        .Cells(iRow, 8) = frmform1.lbactual.Value
        .Cells(iRow, 9) = frmform1.txtproblem.Value
        .Cells(iRow, 10) = frmform1.txtnotes.Value
        .Cells(iRow, 11) = Application.UserName 
        .Cells(iRow, 12) = [Text(Now(), "DD-MM-YYYY HH:MM:SS")] 
      End With
End Sub

Sub Show_Form()
    frmform1.Show    
End Sub

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

Code found on this forum (Joe Was):

Code: 
[B]Private Sub Workbook_SheetActivate(ByVal Sh As Object)[/B]
'ThisWorkbook code module, code only!
'Show only users Rows.
Dim myBot&
Dim userName$
Dim myRng As Range
Dim cell As Object

If ActiveSheet.Name <> "Sheet1" Then Exit Sub

userName = Environ("UserName")
myBot = ActiveSheet.Range("B65536").End(xlUp).Row

Set myRng = ActiveSheet.Range("B3:B" & myBot)

For Each cell In myRng
If UCase(cell.Value) <> UCase(userName) Then cell.EntireRow.Hidden = True
Next cell
[B]End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)[/B]
'ThisWorkbook code module, code only!
'UnHide all rows.
If ActiveSheet.Name <> "Sheet1" Then Exit Sub

ActiveSheet.Columns("B:B").EntireRow.Hidden = False
ActiveSheet.Range("A1").Select
[B]End Sub

Private Sub Workbook_Open()[/B]
'ThisWorkbook code module, code only!
'Show only users Rows.
Dim myBot&
Dim userName$
Dim myRng As Range
Dim cell As Object

userName = Environ("UserName")
myBot = Sheets("Sheet1").Range("B65536").End(xlUp).Row

Set myRng = Sheets("Sheet1").Range("B3:B" & myBot)

For Each cell In myRng
If UCase(cell.Value) <> UCase(userName) Then cell.EntireRow.Hidden = True
Next cell
[B]End Sub[/B]


This is a Re-Set all rows to UnHide macro if you need it as a back-door:


[B]Sub myUnHideSht1Rows()[/B]
'ThisWorkbook code module, code only!
'UnHide all rows.

If ActiveSheet.Name <> "Sheet1" Then Exit Sub

ActiveSheet.Columns("B:B").EntireRow.Hidden = False
ActiveSheet.Range("A1").Select
[B]End Sub[/B]

Thank you,
Tony
 

Excel Facts

Will the fill handle fill 1, 2, 3?
Yes! Type 1 in a cell. Hold down Ctrl while you drag the fill handle.
Sort by date Sort by votes
You must log in or register to reply here.

Similar threads

A
  • Question Question
Run-time error '380' Could not set the Value property. Invalid property value
Replies
7
Views
843
aabrazil1
A
A
  • Question Question
Cannot enter text in textbox on form
Replies
3
Views
273
Anthony47
A
A
  • Question Question
Ambigious Name Detected: Reset
Replies
6
Views
474
aabrazil1
A
S
  • Question Question
User Form not Loading
Replies
5
Views
160
StevieMP
S
E
  • Question Question
Generate unique code based on user form entry and put in table
2
Replies
18
Views
488
Micron
M

Forum statistics

Threads
1,223,877
Messages
6,175,134
Members
452,614
Latest member
MRSWIN2709

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