Hello
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.
Last edited by guatelize; 03-22-2012 at 08:09 AM.
can you confirm there are always blank rows between departments?
PLS DO NOT PM; OPEN A THREAD INSTEAD!!!
1) Posting Code
[CODE]PasteYourCodeHere[/CODE]
(or paste your code, select it, click # button)
2) Uploading File(s)
Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.
3) Testing the Codes
always back up your files before testing the codes.
4) Marking the Thread as Solved
from Thread Tools (on the top right corner, above the first message)
yes, minimum one row
Thanks
If it is to difficult with one blank row, I can manage to seperate the different departments with a thick border around.
Thanks
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:
[vba]
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[/vba]
to standard module
[vba]
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
[/vba]
PLS DO NOT PM; OPEN A THREAD INSTEAD!!!
1) Posting Code
[CODE]PasteYourCodeHere[/CODE]
(or paste your code, select it, click # button)
2) Uploading File(s)
Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.
3) Testing the Codes
always back up your files before testing the codes.
4) Marking the Thread as Solved
from Thread Tools (on the top right corner, above the first message)
Here was my attempt just for info, its a bit lame but none the less it was my attempt.
[VBA]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
[/VBA]
This is super work for both solutions, thank you very much Mancubus & Georgiboy. I wish you a nice sunny week end.
Posting Permissions
Reply With Quote
