PDA

View Full Version : [SOLVED] Hide rows based on username



Egidij
11-20-2018, 12:59 AM
Dear community,

could you please help me with the code I wrote. I would like to hide rows depending which user opens the file:


Sub Macro1()
'
' Macro1 Macro
'
LastRow = 1000
For j = 1 To LastRow
If (Range("A" & j) = Environ("Username")) <> True Then Rows("A" & j).EntireRow.Hidden = True

Next j

End Sub

What I'm doing wrong?

Paul_Hossler
11-20-2018, 07:00 AM
A little simpler, and a lot more general

Try this




Option Explicit

Sub HideRows()
Dim rCell As Range, rData As Range
Dim sUsername As String

Set rData = Nothing
On Error Resume Next
Set rData = ActiveSheet.Columns(1).SpecialCells(xlCellTypeConstants, xlTextValues)
On Error GoTo 0

If rData Is Nothing Then Exit Sub

sUsername = UCase(Environ("Username"))

For Each rCell In rData.Cells
rCell.EntireRow.Hidden = (UCase(rCell.Value) = sUsername)
Next
End Sub

Egidij
11-20-2018, 07:38 AM
Great! Thanks Paul!

How would I reverse the exercise. So rows are hidden and I would like to show only those with the right username?

Thanks.

Paul_Hossler
11-20-2018, 08:22 AM
Probably something like this

It's not 100% bullet-proof, like an empty sheet will probably make it fail, so you might need to add some error handling




Option Explicit

Sub ShowRows()
Dim rCell As Range, rData As Range
Dim sUsername As String


With ActiveSheet
'show all
.Rows.Hidden = False

'hide empty rows at the bottton
Set rCell = .Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0)
Range(rCell, rCell.End(xlDown)).EntireRow.Hidden = True

'get any text cells
Set rData = Nothing
On Error Resume Next
Set rData = ActiveSheet.Columns(1).SpecialCells(xlCellTypeVisible)
On Error GoTo 0

If rData Is Nothing Then Exit Sub

sUsername = UCase(Environ("Username"))

For Each rCell In rData.Cells
rCell.EntireRow.Hidden = (UCase(rCell.Value) <> sUsername)
Next

End With

End Sub