VBA Macro for hiding and unhiding rows is rearranging cells

JasonCExcel

New Member
Joined
Oct 31, 2023
Messages
7
Office Version
  1. 365
Platform
  1. Windows
I have 2 sheets... on each sheet there is a macro that hides and unhides rows. Sheet 2 contains all the data to be hidden or unhidden.

When I code 2 runs to hide an entire section, and then code 1 runs to change the amount of rows (this is in unhidden sections) all of the hidden rows reappear and they are out of order. How can I run these two codes with the rows showing up again?

Code 1 - This code hides an entire section of rows entire section of rows:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

If Target.Address = "$D$10" Then
If Target.Value = "3" Then
Sheets("Criteria Scoring").Rows("43:78").EntireRow.Hidden = True
Else
Sheets("Criteria Scoring").Rows("43:78").EntireRow.Hidden = False
End If
End If
End Sub


___________________________
This code repeats to to hide individual lines in each section (the correct

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False


If Range("D7").Value = 1 Then
Rows("9:17").EntireRow.Hidden = True
Else
Rows("9:17").EntireRow.Hidden = False
If Range("D7").Value = 2 Then
Rows("10:17").EntireRow.Hidden = True
Else
Rows("10:17").EntireRow.Hidden = False
If Range("D7").Value = 3 Then
Rows("11:17").EntireRow.Hidden = True
Else
Rows("11:17").EntireRow.Hidden = False
If Range("D7").Value = 4 Then
Rows("12:17").EntireRow.Hidden = True
Else
Rows("12:17").EntireRow.Hidden = False
If Range("D7").Value = 5 Then
Rows("13:17").EntireRow.Hidden = True
Else
Rows("13:17").EntireRow.Hidden = False
If Range("D7").Value = 6 Then
Rows("14:17").EntireRow.Hidden = True
Else
Rows("14:17").EntireRow.Hidden = False
If Range("D7").Value = 7 Then
Rows("15:17").EntireRow.Hidden = True
Else
Rows("15:17").EntireRow.Hidden = False
If Range("D7").Value = 8 Then
Rows("16:17").EntireRow.Hidden = True
Else
Rows("16:17").EntireRow.Hidden = False
If Range("D7").Value = 9 Then
Rows("17:17").EntireRow.Hidden = True
Else
Rows("17:17").EntireRow.Hidden = False

End If
End If
End If
 

Excel Facts

Why are there 1,048,576 rows in Excel?
The Excel team increased the size of the grid in 2007. There are 2^20 rows and 2^14 columns for a total of 17 billion cells.
I am not seeing the results you describe when I run your code. "Code1" and "Code2" hide and unhide different groups of rows and the groups do not overlap. The rows hide and unhide as expected, and the rows are not out of order. So if you are still seeing a problem I think you many need to post a better example.

I do think you can re-write one of the Subs more efficiently:

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)

    Application.ScreenUpdating = False

    Rows("9:17").EntireRow.Hidden = False
    Select Case Range("D7").Value
        Case 1
            Rows("9:17").EntireRow.Hidden = True
        Case 2
            Rows("10:17").EntireRow.Hidden = True
        Case 3
            Rows("11:17").EntireRow.Hidden = True
        Case 4
            Rows("12:17").EntireRow.Hidden = True
        Case 5
            Rows("13:17").EntireRow.Hidden = True
        Case 6
            Rows("14:17").EntireRow.Hidden = True
        Case 7
            Rows("15:17").EntireRow.Hidden = True
        Case 8
            Rows("16:17").EntireRow.Hidden = True
        Case 9
            Rows("17:17").EntireRow.Hidden = True
    End Select
    Application.ScreenUpdating = True
End Sub


(Tip: For future posts , please try to use code tags like I did above when posting code. It makes your code easier to read and copy.
)
 
Upvote 0
Thank you for that - I knew I hadn't gone the most efficient route but it worked so I left it.

The code was a sample of what I have written since there were so many lines.

Here is what I'm seeing. First image is what the targeted sheet looks like with no changes.

1698859443611.png


The second image shows what happens when I run the code on the other sheet, reducing the criteria groups from 6 to 3.

1698859536972.png


The third image shows what happens when I run the second code, which corresponds to the changing the amount of lines within each criteria group. In this case I changed the number from 10 in the <Criteria1> group to 6 and <Criteria5> group that was hidden via the other code reappears and there are additional lines below that also reappear out of order. There is no overlap in the code since I can confirm individually each code works as desired and I'm not altering any of the hidden cells by running this code. It's just when I run the code to change the amount of criteria groups and THEN run the code to change the amount of lines in a group it all goes haywire.

1698859614278.png
 
Upvote 0
Based on that explanation, I don't think the sample code you posted is an accurate representation of your real code. Unless you are performing a sort operation, the error probably lies in the hide/unhide code and the ranges you are defining for it - and while I know you say there is no range overlap, if I were a betting man, my bet would be that there is but perhaps in a non-obvious way.

But unless you can post something that allows me to recreate the error, there is little I or others can do to help.

FWIW, when you post an image of your data instead of something that can be copied and pasted into a spreadsheet, it is difficult for others to experiment with it. Which means your chances of getting help drop significantly. Instead, use the free XL2BB tool designed for MrExcel (link below) to post your data in a way that makes it accessible to others.

 
Upvote 0
This entirety of my code. No sort functions or anything else is in play.

This is on the criteria sheet:

Private Sub Worksheet_Change(ByVal Target As Range)

Application.ScreenUpdating = False
If Range("D3").Value = 4 Then
Columns("I:L").EntireColumn.Hidden = True
Else
Columns("I:L").EntireColumn.Hidden = False
If Range("D3").Value = 5 Then
Columns("J:L").EntireColumn.Hidden = True
Else
Columns("J:L").EntireColumn.Hidden = False
If Range("D3").Value = 6 Then
Columns("K:L").EntireColumn.Hidden = True
Else
Columns("K:L").EntireColumn.Hidden = False
If Range("D3").Value = 7 Then
Columns("L:L").EntireColumn.Hidden = True
Else
Columns("L:L").EntireColumn.Hidden = False
End If
End If
End If
End If

If Range("D7").Value = 1 Then
Rows("9:17").EntireRow.Hidden = True
Else
Rows("9:17").EntireRow.Hidden = False
If Range("D7").Value = 2 Then
Rows("10:17").EntireRow.Hidden = True
Else
Rows("10:17").EntireRow.Hidden = False
If Range("D7").Value = 3 Then
Rows("11:17").EntireRow.Hidden = True
Else
Rows("11:17").EntireRow.Hidden = False
If Range("D7").Value = 4 Then
Rows("12:17").EntireRow.Hidden = True
Else
Rows("12:17").EntireRow.Hidden = False
If Range("D7").Value = 5 Then
Rows("13:17").EntireRow.Hidden = True
Else
Rows("13:17").EntireRow.Hidden = False
If Range("D7").Value = 6 Then
Rows("14:17").EntireRow.Hidden = True
Else
Rows("14:17").EntireRow.Hidden = False
If Range("D7").Value = 7 Then
Rows("15:17").EntireRow.Hidden = True
Else
Rows("15:17").EntireRow.Hidden = False
If Range("D7").Value = 8 Then
Rows("16:17").EntireRow.Hidden = True
Else
Rows("16:17").EntireRow.Hidden = False
If Range("D7").Value = 9 Then
Rows("17:17").EntireRow.Hidden = True
Else
Rows("17:17").EntireRow.Hidden = False

End If
End If
End If
End If
End If
End If
End If
End If
End If

If Range("D19").Value = 1 Then
Rows("21:29").EntireRow.Hidden = True
Else
Rows("21:29").EntireRow.Hidden = False
If Range("D19").Value = 2 Then
Rows("22:29").EntireRow.Hidden = True
Else
Rows("22:29").EntireRow.Hidden = False
If Range("D19").Value = 3 Then
Rows("23:29").EntireRow.Hidden = True
Else
Rows("23:29").EntireRow.Hidden = False
If Range("D19").Value = 4 Then
Rows("24:29").EntireRow.Hidden = True
Else
Rows("24:29").EntireRow.Hidden = False
If Range("D19").Value = 5 Then
Rows("25:29").EntireRow.Hidden = True
Else
Rows("25:29").EntireRow.Hidden = False
If Range("D19").Value = 6 Then
Rows("26:29").EntireRow.Hidden = True
Else
Rows("26:29").EntireRow.Hidden = False
If Range("D19").Value = 7 Then
Rows("27:29").EntireRow.Hidden = True
Else
Rows("27:29").EntireRow.Hidden = False
If Range("D19").Value = 8 Then
Rows("28:29").EntireRow.Hidden = True
Else
Rows("28:29").EntireRow.Hidden = False
If Range("D19").Value = 9 Then
Rows("29:29").EntireRow.Hidden = True
Else
Rows("29:29").EntireRow.Hidden = False

End If
End If
End If
End If
End If
End If
End If
End If
End If

If Range("D31").Value = 1 Then
Rows("33:41").EntireRow.Hidden = True
Else
Rows("33:41").EntireRow.Hidden = False
If Range("D31").Value = 2 Then
Rows("34:41").EntireRow.Hidden = True
Else
Rows("34:41").EntireRow.Hidden = False
If Range("D31").Value = 3 Then
Rows("35:41").EntireRow.Hidden = True
Else
Rows("35:41").EntireRow.Hidden = False
If Range("D31").Value = 4 Then
Rows("36:41").EntireRow.Hidden = True
Else
Rows("36:41").EntireRow.Hidden = False
If Range("D31").Value = 5 Then
Rows("37:41").EntireRow.Hidden = True
Else
Rows("37:41").EntireRow.Hidden = False
If Range("D31").Value = 6 Then
Rows("38:41").EntireRow.Hidden = True
Else
Rows("38:41").EntireRow.Hidden = False
If Range("D31").Value = 7 Then
Rows("39:41").EntireRow.Hidden = True
Else
Rows("39:41").EntireRow.Hidden = False
If Range("D31").Value = 8 Then
Rows("40:41").EntireRow.Hidden = True
Else
Rows("40:41").EntireRow.Hidden = False
If Range("D31").Value = 9 Then
Rows("41:41").EntireRow.Hidden = True
Else
Rows("41:41").EntireRow.Hidden = False

End If
End If
End If
End If
End If
End If
End If
End If
End If

If Range("D43").Value = 1 Then
Rows("45:53").EntireRow.Hidden = True
Else
Rows("45:53").EntireRow.Hidden = False
If Range("D43").Value = 2 Then
Rows("46:53").EntireRow.Hidden = True
Else
Rows("46:53").EntireRow.Hidden = False
If Range("D43").Value = 3 Then
Rows("47:53").EntireRow.Hidden = True
Else
Rows("47:53").EntireRow.Hidden = False
If Range("D43").Value = 4 Then
Rows("48:53").EntireRow.Hidden = True
Else
Rows("48:53").EntireRow.Hidden = False
If Range("D43").Value = 5 Then
Rows("49:53").EntireRow.Hidden = True
Else
Rows("49:53").EntireRow.Hidden = False
If Range("D43").Value = 6 Then
Rows("50:53").EntireRow.Hidden = True
Else
Rows("50:53").EntireRow.Hidden = False
If Range("D43").Value = 7 Then
Rows("51:53").EntireRow.Hidden = True
Else
Rows("51:53").EntireRow.Hidden = False
If Range("D43").Value = 8 Then
Rows("52:53").EntireRow.Hidden = True
Else
Rows("52:53").EntireRow.Hidden = False
If Range("D43").Value = 9 Then
Rows("53:53").EntireRow.Hidden = True
Else
Rows("52:53").EntireRow.Hidden = False

End If
End If
End If
End If
End If
End If
End If
End If
End If

If Range("D55").Value = 1 Then
Rows("57:65").EntireRow.Hidden = True
Else
Rows("57:65").EntireRow.Hidden = False
If Range("D55").Value = 2 Then
Rows("58:65").EntireRow.Hidden = True
Else
Rows("58:65").EntireRow.Hidden = False
If Range("D55").Value = 3 Then
Rows("59:65").EntireRow.Hidden = True
Else
Rows("59:65").EntireRow.Hidden = False
If Range("D55").Value = 4 Then
Rows("60:65").EntireRow.Hidden = True
Else
Rows("60:65").EntireRow.Hidden = False
If Range("D55").Value = 5 Then
Rows("61:65").EntireRow.Hidden = True
Else
Rows("61:65").EntireRow.Hidden = False
If Range("D55").Value = 6 Then
Rows("62:65").EntireRow.Hidden = True
Else
Rows("62:65").EntireRow.Hidden = False
If Range("D55").Value = 7 Then
Rows("63:65").EntireRow.Hidden = True
Else
Rows("63:65").EntireRow.Hidden = False
If Range("D55").Value = 8 Then
Rows("64:65").EntireRow.Hidden = True
Else
Rows("64:65").EntireRow.Hidden = False
If Range("D55").Value = 9 Then
Rows("65:65").EntireRow.Hidden = True
Else
Rows("65:53").EntireRow.Hidden = False

End If
End If
End If
End If
End If
End If
End If
End If
End If
If Range("D67").Value = 1 Then
Rows("69:77").EntireRow.Hidden = True
Else
Rows("69:77").EntireRow.Hidden = False
If Range("D67").Value = 2 Then
Rows("70:77").EntireRow.Hidden = True
Else
Rows("70:77").EntireRow.Hidden = False
If Range("D67").Value = 3 Then
Rows("71:77").EntireRow.Hidden = True
Else
Rows("71:77").EntireRow.Hidden = False
If Range("D67").Value = 4 Then
Rows("72:77").EntireRow.Hidden = True
Else
Rows("72:77").EntireRow.Hidden = False
If Range("D67").Value = 5 Then
Rows("73:77").EntireRow.Hidden = True
Else
Rows("73:77").EntireRow.Hidden = False
If Range("D67").Value = 6 Then
Rows("74:77").EntireRow.Hidden = True
Else
Rows("74:77").EntireRow.Hidden = False
If Range("D67").Value = 7 Then
Rows("75:77").EntireRow.Hidden = True
Else
Rows("75:77").EntireRow.Hidden = False
If Range("D67").Value = 8 Then
Rows("76:77").EntireRow.Hidden = True
Else
Rows("76:77").EntireRow.Hidden = False
If Range("D67").Value = 9 Then
Rows("77:77").EntireRow.Hidden = True
Else
Rows("77:77").EntireRow.Hidden = False

End If
End If
End If
End If
End If
End If
End If
End If
End If


End Sub


This is on Sheet 1:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False

If Target.Address = "$D$10" Then
If Target.Value = "3" Then
Sheets("Criteria Scoring").Rows("43:78").EntireRow.Hidden = True
Else
Sheets("Criteria Scoring").Rows("43:78").EntireRow.Hidden = False
End If
End If
End Sub
 
Upvote 0
Perhaps something like this.

This is on Sheet 1:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim tmpCriteria As Long
   
    Application.ScreenUpdating = False
    If Target.Address = "$D$10" Then
        With ThisWorkbook.Worksheets("Criteria Scoring")
            If Target.Value = "3" Then
                .Rows("43:78").EntireRow.Hidden = True
            Else
                tmpCriteria = .Range("D7").Value
                .Rows("43:78").EntireRow.Hidden = False
                .Range("D7").Value = tmpCriteria
            End If
        End With
    End If
    Application.ScreenUpdating = False
End Sub

This is on the criteria sheet:
VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim rngCriteria As Range
    Dim I As Long
    Dim R As Range
    Dim rngRows As Range
    Dim Ofs As Long
   
    Application.ScreenUpdating = False
   
    Me.Range("I1").Resize(, 4).EntireColumn.Hidden = False
   
    Select Case Range("D3").Value
        Case 4 To 7
            Ofs = Me.Range("D3").Value - 4
            With Me.Range("I1").Offset(, Ofs).Resize(, 4 - Ofs)
                .EntireColumn.Hidden = True
            End With
    End Select
   
    Set rngCriteria = Me.Range("D7")
   
    For I = 1 To 5
        Set rngCriteria = Union(rngCriteria, Me.Range("D7").Offset(12 * I))
    Next I
   
    If Not Application.Intersect(Target, rngCriteria) Is Nothing Then
        For Each R In rngCriteria
            Set rngRows = R.Offset(2).Resize(9)
            rngRows.EntireRow.Hidden = False
            Select Case R.Value
                Case 1 To 9
                    Ofs = R.Value - 1
                    rngRows.EntireRow.Offset(Ofs).Resize(rngRows.Rows.count - (Ofs)).Hidden = True
            End Select
        Next R
    End If
    Application.ScreenUpdating = True
End Sub

Sheets("Sheet2").Range("D10") <> 3
Book4
ABCDE
6
7<Criteria 1>3
81
92
103
18Average Score
19<Criteria 2>5
201
212
223
234
245
30Average Score
31<Criteria 3>2
321
332
42Average Score
43<Criteria 4>2
441
452
54Average Score
55<Criteria 5>8
561
572
583
594
605
616
627
638
66Average Score
67<Criteria 6>2
681
692
78Average Score
79
80
Criteria Scoring


Sheets("Sheet2").Range("D10") = 3
Book4
ABCDE
6
7<Criteria 1>3
81
92
103
18Average Score
19<Criteria 2>5
201
212
223
234
245
30Average Score
31<Criteria 3>2
321
332
42Average Score
79
80
Criteria Scoring
 
Upvote 0
I replaced all the code as suggested but the result seems to be the same. Once I reduce the criteria down to 3 and then adjust the count of criteria in and of the group the bottom of the sheet still shows the same. No leftover code exists.

1698944677062.png
 
Upvote 0
Hi,
This is a bit of a guess & I have only lightly tested but see if this update to your codes will do what you want

Criteria worksheet code page

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i           As Long
    Dim HideRange   As Boolean, HideColumns As Boolean
    Dim rngHide     As Range, rngInput      As Range
    
    Set rngInput = Range("D3,D7,D19,D31,D43,D55,D67")
    
    If Not Application.Intersect(Target, rngInput) Is Nothing Then
        
        HideColumns = Target.Address = "$D$3"
        
        Set rngHide = IIf(HideColumns, Target.Offset(, 5).Resize(, 4), Target.Offset(2).Resize(9))
        
        With rngHide
            For i = 1 To IIf(HideColumns, 4, 9)
                HideRange = i + IIf(HideColumns, 3, 0) = Target.Value
                
                If HideColumns Then
                    .Offset(, (i - 1)).Resize(, .Columns.Count - (i - 1)).EntireColumn.Hidden = HideRange
                Else
                    .Offset(i - 1).Resize(.Rows.Count - (i - 1)).EntireRow.Hidden = HideRange
                End If
                
                If HideRange Then Exit For
            Next i
        End With
        
    End If
    
End Sub

Sheet1 Code page

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsCriteriaScoring As Worksheet
    
    On Error GoTo myerror
    
    Set wsCriteriaScoring = ThisWorkbook.Worksheets("Criteria Scoring")
    
    If Target.Address = "$D$10" Then
        Application.EnableEvents = False
        wsCriteriaScoring.Rows("43:78").EntireRow.Hidden = Val(Target.Value) = 3
    End If
    
myerror:
    Application.EnableEvents = True
End Sub

Hope Helpful

Dave
 
Upvote 0
I replaced all the code as suggested but the result seems to be the same. Once I reduce the criteria down to 3 and then adjust the count of criteria in and of the group the bottom of the sheet still shows the same. No leftover code exists.
I have to wonder if you tried my code as posted, or if the structure of your worksheet is different than described? As an experiment, use a new workbook and paste this data as shown into a sheet that you name "Criteria Scoring"

Then add the code I posted above and test.

Book4
ABCDEFG
1
2
3
4
5
6
7<Criteria 1>10
81
92
103
114
125
136
147
158
169
1710
18Average Score
19<Criteria 1>10
201
212
223
234
245
256
267
278
289
2910
30Average Score
31<Criteria 1>10
321
332
343
354
365
376
387
398
409
4110
42Average Score
43<Criteria 1>10
441
452
463
474
485
496
507
518
529
5310
54Average Score
55<Criteria 1>10
561
572
583
594
605
616
627
638
649
6510
66Average Score
67<Criteria 1>10
681
692
703
714
725
736
747
758
769
7710
78Average Score
79
80
Criteria Scoring
 
Upvote 0
Hi,
This is a bit of a guess & I have only lightly tested but see if this update to your codes will do what you want

Criteria worksheet code page

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i           As Long
    Dim HideRange   As Boolean, HideColumns As Boolean
    Dim rngHide     As Range, rngInput      As Range
   
    Set rngInput = Range("D3,D7,D19,D31,D43,D55,D67")
   
    If Not Application.Intersect(Target, rngInput) Is Nothing Then
       
        HideColumns = Target.Address = "$D$3"
       
        Set rngHide = IIf(HideColumns, Target.Offset(, 5).Resize(, 4), Target.Offset(2).Resize(9))
       
        With rngHide
            For i = 1 To IIf(HideColumns, 4, 9)
                HideRange = i + IIf(HideColumns, 3, 0) = Target.Value
               
                If HideColumns Then
                    .Offset(, (i - 1)).Resize(, .Columns.Count - (i - 1)).EntireColumn.Hidden = HideRange
                Else
                    .Offset(i - 1).Resize(.Rows.Count - (i - 1)).EntireRow.Hidden = HideRange
                End If
               
                If HideRange Then Exit For
            Next i
        End With
       
    End If
   
End Sub

Sheet1 Code page

VBA Code:
Private Sub Worksheet_Change(ByVal Target As Range)
    Dim wsCriteriaScoring As Worksheet
   
    On Error GoTo myerror
   
    Set wsCriteriaScoring = ThisWorkbook.Worksheets("Criteria Scoring")
   
    If Target.Address = "$D$10" Then
        Application.EnableEvents = False
        wsCriteriaScoring.Rows("43:78").EntireRow.Hidden = Val(Target.Value) = 3
    End If
   
myerror:
    Application.EnableEvents = True
End Sub

Hope Helpful

Dave
Hi Dave,

This was indeed helpful, it solved the issue. The only outstanding item is that I need to expand this code to hide other criteria groups. Would a simple Elself or would there by a more efficient way? I need the same cell when changed to 4,5

4 - Rows 55:78

5 - Rows 68:78


Thank you all for your help. This will be a huge time saver for my team.

Best,
Jason
 
Upvote 0

Forum statistics

Threads
1,223,954
Messages
6,175,603
Members
452,658
Latest member
GStorm

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top