PDA

View Full Version : Solved: Hide Rows under the criteria above



guatelize
03-22-2012, 07:53 AM
Hello:help :think: : pray2:
I have a big database, where in column A the actual presence of a department is shown. I wish to hide the Rows (with "C") under the department with the same Dept. nr. when the persons left, but leaving the department name unhidden. But when I change the Status of the department (with "O"), I wish to unhide the list under that department.
Attached a file with example.
Thanks for your help.

mancubus
03-23-2012, 02:21 AM
can you confirm there are always blank rows between departments?

guatelize
03-23-2012, 03:17 AM
yes, minimum one row
Thanks

guatelize
03-23-2012, 03:23 AM
If it is to difficult with one blank row, I can manage to seperate the different departments with a thick border around.
Thanks

mancubus
03-23-2012, 06:25 AM
file is attached.
hope that helps..



it's a Worksheet_Change event and uses UDF IsCritRow

IsCritRow checks if the cell is in column A, if its value is C or O, if corresponding cell in column D is blank... if all conditions are met then it returns True

to related worksheet's code module:

Private Sub Worksheet_Change(ByVal Target As Range)

If Not IsCritRow(Target) Then Exit Sub
If Target.Column <> 1 Then Exit Sub
If Target.Count > 1 Then Exit Sub

If UCase(Target.Value) = "O" Then
If Rows(Target.Offset(1).Row).Hidden = True Then
Range(Target.Offset(1), Target.End(xlDown)).Rows.Hidden = False
End If
ElseIf UCase(Target.Value) = "C" Then
If Rows(Target.Offset(1).Row).Hidden = False Then
Range(Target.Offset(1), Target.End(xlDown)).Rows.Hidden = True
End If
End If

End Sub


to standard module

Public Function IsCritRow(cll As Range) As Boolean
If cll.Count > 1 Then Exit Function
IsCritRow = _
cll.Column = 1 _
And _
(UCase(cll.Value) = "O" Or UCase(cll.Value) = "C") _
And _
Len(Trim(Cells(cll.Row, 4))) = 0
End Function

georgiboy
03-23-2012, 06:44 AM
Here was my attempt just for info, its a bit lame but none the less it was my attempt.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim x As Long, rng As String

On Error GoTo ender
If Not Intersect(Target, Range("A:A")) Is Nothing Then
If UCase(Target.Value) = "C" Then
Rows(Target.Row + 1 & ":" & Target.End(xlDown).Row).EntireRow.Hidden = True
Else
x = Target.Row
Do
x = x + 1
If Range("A" & x).Value <> "" Then
rng = Range("A" & x).Address
Else
GoTo jump1
End If
Loop
jump1:
Range(Target, Range(rng)).EntireRow.Hidden = False
End If
End If
ender:
End Sub

guatelize
03-23-2012, 07:41 AM
This is super work for both solutions, thank you very much Mancubus & Georgiboy. I wish you a nice sunny week end.