VBA Macro for hiding and unhiding rows is rearranging cells

JasonCExcel · Oct 31, 2023

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

rlv01 · Nov 1, 2023

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.

How to Post Your VBA Code

Post your VBA code.

www.mrexcel.com

)

JasonCExcel · Nov 1, 2023

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.

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

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.

rlv01 · Nov 1, 2023

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.

XL2BB - Excel Range to BBCode

Excel 'mini-sheet' in messages - XL2BB Although experts prefer to read your description and question instead of working in your actual file to solve your problem, there are times that it is difficult to explain an issue without providing actual...

www.mrexcel.com

JasonCExcel · Nov 1, 2023

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

rlv01 · Nov 1, 2023

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

A

B

C

D

E

6

7

3

8

1

9

2

10

3

18

Average Score

19

5

20

1

21

2

22

3

23

4

24

5

30

Average Score

31

2

32

1

33

2

42

Average Score

43

2

44

1

45

2

54

Average Score

55

8

56

1

57

2

58

3

59

4

60

5

61

6

62

7

63

8

66

Average Score

67

2

68

1

69

2

78

Average Score

79

80

Criteria Scoring

Sheets("Sheet2").Range("D10") = 3

Book4

A

B

C

D

E

6

7

3

8

1

9

2

10

3

18

Average Score

19

5

20

1

21

2

22

3

23

4

24

5

30

Average Score

31

2

32

1

33

2

42

Average Score

79

80

Criteria Scoring

JasonCExcel · Nov 2, 2023

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.

dmt32 · Nov 2, 2023

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

rlv01 · Nov 2, 2023

JasonCExcel said:
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

A

B

C

D

E

F

G

1

2

3

4

5

6

7

10

8

1

9

2

10

3

11

4

12

5

13

6

14

7

15

8

16

9

17

10

18

Average Score

19

10

20

1

21

2

22

3

23

4

24

5

25

6

26

7

27

8

28

9

29

10

30

Average Score

31

10

32

1

33

2

34

3

35

4

36

5

37

6

38

7

39

8

40

9

41

10

42

Average Score

43

10

44

1

45

2

46

3

47

4

48

5

49

6

50

7

51

8

52

9

53

10

54

Average Score

55

10

56

1

57

2

58

3

59

4

60

5

61

6

62

7

63

8

64

9

65

10

66

Average Score

67

10

68

1

69

2

70

3

71

4

72

5

73

6

74

7

75

8

76

9

77

10

78

Average Score

79

80

Criteria Scoring

JasonCExcel · Nov 2, 2023

dmt32 said:

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

VBA Macro for hiding and unhiding rows is rearranging cells

JasonCExcel

New Member

Excel Facts

rlv01

Well-known Member

How to Post Your VBA Code

JasonCExcel

New Member

rlv01

Well-known Member

XL2BB - Excel Range to BBCode

JasonCExcel

New Member

rlv01

Well-known Member

JasonCExcel

New Member

dmt32

Well-known Member

rlv01

Well-known Member

JasonCExcel

New Member

Similar threads

Forum statistics

Share this page

VBA Macro for hiding and unhiding rows is rearranging cells

New Member

Excel Facts

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

New Member

Well-known Member

Well-known Member

New Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock