Vis skjulte Rækker i regneark hvis celle ændrer sig

Noget i denne stil vil kunne bruges:

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
Range("A3:Y3").Select
Name = Range("A1")
Range("A2:A200").EntireRow.Hidden = True ' tilpas efter behow
Select Case Name
Case "Lotte"
Range("A2:A20").EntireRow.Hidden = False
Case "Mette"
Range("A21:A40").EntireRow.Hidden = False
Case "Nora"
Range("A41:A60").EntireRow.Hidden = False
Case "Olga"
Range("A61:A80").EntireRow.Hidden = False
Case Else
MsgBox ("Navn ukendt")
End Select

End If
End Sub

Du får en lidt bedre version. Tager ikke hensyn til om navnet er skrevet med stort, og viser alle linier, hvis A1 er tom.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1")) Is Nothing Then
If Range("A1") = "" Then
Range("A2:A200").EntireRow.Hidden = False
Else
Name = Application.Proper(Range("A1"))
Range("A2:A200").EntireRow.Hidden = True ' tilpas efter behow
Select Case Name
Case "Lotte"
Range("A2:A20").EntireRow.Hidden = False
Case "Mette"
Range("A21:A40").EntireRow.Hidden = False
Case "Nora"
Range("A41:A60").EntireRow.Hidden = False
Case "Olga"
Range("A61:A80").EntireRow.Hidden = False
Case "Else"
Range("A81:A100").EntireRow.Hidden = False
Case Else
MsgBox ("Navn ukendt")
End Select
Range("A1").Select
End If
End If
End Sub

Fedt det virker :)
Mange tak for hjælpen, smid et svar så skal du få dine point

Du får et svar