CODEWITHSUNDEEP
excelvba
user2131846
user2131846

Reputation: 1

Get Excel Macro to AUTO run on sheet 2 when cell value changes in sheet 1

I am trying to create a simple Excel quotation sheet for my boss, where it must hide the rows that dont apply is a certain cell value is = 0, but if it is = 1, then display in sheet 2.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("H5")) Is Nothing Then Macro
End Sub

Sub HURows()
BeginRow = 17
EndRow = 34
ChkCol = 4

For RowCnt = BeginRow To EndRow
    If Cells(RowCnt, ChkCol).Value = 1 Then
        Cells(RowCnt, ChkCol).EntireRow.Hidden = False
    Else
        Cells(RowCnt, ChkCol).EntireRow.Hidden = True
    End If
Next RowCnt

BeginRow = 37
EndRow = 44
ChkCol = 4

For RowCnt = BeginRow To EndRow
    If Cells(RowCnt, ChkCol).Value = 1 Then
        Cells(RowCnt, ChkCol).EntireRow.Hidden = False
    Else
        Cells(RowCnt, ChkCol).EntireRow.Hidden = True
    End If
Next RowCnt

BeginRow = 48
EndRow = 51
ChkCol = 4

For RowCnt = BeginRow To EndRow
    If Cells(RowCnt, ChkCol).Value = 1 Then
        Cells(RowCnt, ChkCol).EntireRow.Hidden = False
    Else
        Cells(RowCnt, ChkCol).EntireRow.Hidden = True
    End If
Next RowCnt
End Sub

Please can you advise me on how to get this macro to Automatically run on cell value changes....

Upvotes: 0

Views: 3413

Answers (1)

NickSlash
NickSlash

Reputation: 5077

If your Worksheet_Change sub and If statement are actually used for the Macro macro then you will need to copy the If statement from my example into yours, if its not used then you can just replace it.

Its not the most efficient as some of your cells in this column dont hide/unhide rows so the sub may be called more times than required but it should do not harm.

The following code should be placed into the worksheet code for Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)
  If Not Intersect(Target, Sheet1.Columns(4)) Is Nothing Then
      ' Target Intersects
      HURows
  Else
      ' No Intersection
  End If
End Sub

This code should be placed into a new Module (and not worksheet or workbook module)

Sub HURows()
Dim Sheet As Worksheet
BeginRow = 17
EndRow = 34
ChkCol = 4

Set Sheet = ThisWorkbook.Worksheets("Sheet2")
For RowCnt = BeginRow To EndRow
    If Sheet.Cells(RowCnt, ChkCol).Value = 1 Then
        Sheet.Cells(RowCnt, ChkCol).EntireRow.Hidden = False
    Else
        Sheet.Cells(RowCnt, ChkCol).EntireRow.Hidden = True
    End If
Next RowCnt

BeginRow = 37
EndRow = 44
ChkCol = 4

For RowCnt = BeginRow To EndRow
    If Sheet.Cells(RowCnt, ChkCol).Value = 1 Then
        Sheet.Cells(RowCnt, ChkCol).EntireRow.Hidden = False
    Else
        Sheet.Cells(RowCnt, ChkCol).EntireRow.Hidden = True
    End If
Next RowCnt

BeginRow = 48
EndRow = 51
ChkCol = 4

For RowCnt = BeginRow To EndRow
    If Sheet.Cells(RowCnt, ChkCol).Value = 1 Then
        Sheet.Cells(RowCnt, ChkCol).EntireRow.Hidden = False
    Else
        Sheet.Cells(RowCnt, ChkCol).EntireRow.Hidden = True
    End If
Next RowCnt
End Sub

Upvotes: 1

Related Questions