Add a stipulation to my display SUB

david francisco
david francisco used Ask the Experts™
on
I have a display function that will display data from my worksheet to a locked textbox, Now i want to build upon my code to only display if the cells in column
D = Environ("Username")

Open in new window


The code i am currently using for displaying the code is
Private Sub CommandButton39_Click()

    Range("B1:B37").Select
    ActiveWorkbook.Worksheets("FUN1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("FUN1").Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("FUN1").Sort
        .SetRange Range("A1:D37")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Me.TextBox4.Value = ""
Dim wb As Workbook
Workbooks("Working.xlsm").Activate
Dim arrIn As Variant
Dim arrOut()
Dim i As Long
Dim j As Long

    arrIn = Sheets("FUN1").Range("A1").CurrentRegion
    
    ReDim arrOut(1 To UBound(arrIn))
    
    For i = 1 To UBound(arrIn)
    
        For j = 1 To UBound(arrIn, 2) - 1
            arrOut(i) = arrOut(i) & arrIn(i, j) & vbTab
        Next j
        
        arrOut(i) = arrOut(i) & arrIn(i, j)
    
    Next i
    
    With TextBox4
        .MultiLine = True
        .Value = Join(arrOut, vbCrLf)
    End With
End Sub

Open in new window

Comment
Watch Question

Do more with

Expert Office
EXPERT OFFICE® is a registered trademark of EXPERTS EXCHANGE®
Roy CoxGroup Finance Manager

Commented:
Can you attach the workbook
Most Valuable Expert 2011
Top Expert 2011
Commented:
Untested, but try this:

Private Sub CommandButton39_Click()

    Range("B1:B37").Select
    ActiveWorkbook.Worksheets("FUN1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("FUN1").Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("FUN1").Sort
        .SetRange Range("A1:D37")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
Me.TextBox4.Value = ""
Dim wb As Workbook
Workbooks("Working.xlsm").Activate
Dim arrIn As Variant
Dim arrOut()
Dim i As Long
Dim j As Long
Dim counter As Long
Dim outRow As Long
Dim sUser As String
sUser = VBA.LCase$(Environ("username"))
With Sheets("FUN1").Range("A1").CurrentRegion
    arrIn = .Value
    counter = Application.CountIf(.Columns(4), sUser)
    
    ReDim arrOut(1 To counter)
    outRow = 1
    For i = 1 To UBound(arrIn)
        If VBA.LCase$(arrIn(i, 4)) = sUser Then
            For j = 1 To UBound(arrIn, 2) - 1
                arrOut(outRow) = arrOut(outRow) & arrIn(i, j) & vbTab
            Next j
            
            arrOut(outRow) = arrOut(outRow) & arrIn(i, j)
            outRow = outRow + 1
        End If
    Next i
    
    With TextBox4
        .MultiLine = True
        .Value = Join(arrOut, vbCrLf)
    End With
End Sub

Open in new window

Author

Commented:
@Roy Cox, no i cannot.

@Rory Archibald, it worked great! thanks for the help! i had tried a couple of solutions that actually were close to what you posted, and i had to add another end with before the end sub of your code, but it worked perfectly.

Do more with

Expert Office
Submit tech questions to Ask the Experts™ at any time to receive solutions, advice, and new ideas from leading industry professionals.

Start 7-Day Free Trial