I have read a number of posts about hiding rows in Excel, and they all helped me with the hiding, but I still don't seem to find any solutions for why it will not UNHIDE.
I am using the following code:
Private Sub Worksheet_Calculate()
Dim LastRow As Long, c As Range
Application.EnableEvents = False
LastRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row
On Error Resume Next
For Each c In Range("D116:D" & LastRow)
If c.Value = 0 Then
c.EntireRow.Hidden = True
ElseIf c.Value > 0 Then
c.EntireRow.Hidden = False
End If
Next
On Error GoTo 0
Application.EnableEvents = True
End Sub
If I start with some 1 and some 0 values, then the code successfully hides the rows with value 0, AND also continues to be active, ensuring that any values I later change from 1 to 0 are automatically hidden.
However, the values that were initially 0, once changed to 1, will not UNHIDE automatically. This is a big problem because I intend to start with all zero values, and then unhide rows as these values change to 1 or greater than 1. It's worth of note that these values in column D are references to somewhere else in the same spreadsheet (just for instance =N100), so that I can control the values even when the rows are hidden. I didn't think the use of a formula was a problem because it can still respond to dynamic changes to HIDE (when changed from 1 to 0), just not to UNHIDE.
Any suggestions?
Thanks to all who helped. Thanks to Ads help I created a macro, and from that code I got the line that I was missing: Activate. The code now works as:
Private Sub Worksheet_Calculate()
Dim LastRow As Long, c As Range
Application.EnableEvents = False
LastRow = Cells(Cells.Rows.Count, "D").End(xlUp).Row
On Error Resume Next
For Each c In Range("D116:D" & LastRow)
If c.Value = 0 Then
c.EntireRow.Hidden = True
ElseIf c.Value > 0 Then
c.Activate
c.EntireRow.Hidden = False
End If
Next
On Error GoTo 0
Application.EnableEvents = True
End Sub
I'm not sure exactly how to show a row in VBA, what you have looks right to show a row. But when I was ever unsure how to do something, I would record a macro to do what I wanted to achieve and then just review the code that excel generates.
Related
I have a VBA code that removes empty cells, allowing for data further down in the column to move up to the top. There are two things that I am looking to fix. One, I don't want to exit the sub, I want to exit the if statement. I've read that you can exit loops, whiles, fors, etc. But not ifs. I don't want to exit the sub because I have more code in my sub. Any suggestions?
I am also having issues adding another line in the code to run if there is already data at the top of the column.
Sub Remove_Empties ()
Dim Last as Long
Dim Mcol as Range
Last = Cells(Rows.Count, "AD").End(xlUp).Row
If Last = 1 Then Exit Sub 'no value only header in row 1
'otherwise
Set Mcol = Range("AD2:AD" & Last) 'contains any value
Application.ScreenUpdating = True
Mcol.SpecialCells(xlCellTypeBlanks).Delete xlUp
Application.ScreenUpdating = True
End Sub
I want it to be able to run the following three scenarios. The first contains data in the row below the header. The second has a couple of empty cells. The third has all empty cells. 1 should not change, 2 should change to match 1's format, and 3 should do nothing. 2 and 3 can be done with the code above, but not 1.
1 2 3
A
B
C A
D B
C
D
Perhaps something like this, noting the following:
You don't need two Application.ScreenUpdating = True lines. You can probably get rid of both.
You need to handle the possibility of no blank cells (column 1).
Sub Remove_Empties()
Dim Last As Long
Last = Cells(Rows.Count, "AD").End(xlUp).Row
If Last <> 1 Then
Dim Mcol As Range
Set Mcol = Range("AD2:AD" & Last) 'contains any value
Dim cellsToDelete As Range
On Error Resume Next
Set cellsToDelete = Mcol.SpecialCells(xlCellTypeBlanks)
On Error GoTo 0
If Not cellsToDelete Is Nothing Then
cellsToDelete.Delete shift:=xlUp
End If
End If
End Sub
Or slightly condensed:
Sub Remove_Empties()
Dim Last As Long
Last = Cells(Rows.Count, "AD").End(xlUp).Row
If Last <> 1 Then
On Error Resume Next
Range("AD2:AD" & Last).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlUp
On Error GoTo 0
End If
End Sub
I will just add another answer that you can possibly use in your logic (code) moving forward. Using a simple GoTo statement will break out of an If. For example:
Sub UsingGoTo()
If Last = 1 Then
'do something
GoTo CheckComplete
Else
'if not maybe exit sub?
Exit Sub
End If
CheckComplete:
'continue with program
End Sub
Essentially, when running the below code within one workbook (1 sheet) it completes within an instant. But when using it in my main workbook (couple of sheets, barely any data) it takes a while to complete. How can I optimize the below code?
Sub DeleteBlankRows()
On Error Resume Next
Sheets("Sheet4").Activate
Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End Sub
Try avoiding the use of an entire column, as well as .Activate:
Sub DeleteBlankRows()
' On Error Resume Next
Dim lastRow As Long
With Sheets("Sheet4")
lastRow = .Cells(Rows.Count, 4).End(xlUp).row
.Range(.Cells(1, 4), .Cells(lastRow, 4)).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
End Sub
Edit: Commented out the On Error Resume Next
you could try too to stop the automatic calculation and screen update and at the end reenable all.
try this and test too with the other codes
Sub DeleteBlankRows()
Application.ScreenUpdating = False
Application.Calculation = xlManual
On Error Resume Next
Sheets("Sheet4").Activate
Columns("D").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
Application.ScreenUpdating = true
Application.Calculation = xlAutomatic
End Sub
Good Luck
lastRow = .Cells(Rows.Count, 4).End(xlUp).row
I never use this method for figuring out last row. It takes too long... Basically processing every cell starting from the bottom of the worksheet. Instead, I count the number of cells with values. I use that number to run a for loop which tests to see if there is a value in a given cell and counts until all cells with values are accounted for. Code wise, its more complicated... but in my experience executes more quickly.
kount = Application.WorksheetFunction.CountA(krng) 'Count how many used cells there are
kRow = 1
j = 1
Do Until j = kount + 1 'Do until all used cells are acounted for
If Cells(kRow, l).Value = vbNullString Then 'If current cell is empty skip it
Else
j = j + 1 'If the current cell has a value count up
End If
kRow = kRow + 1 'but go on to the next row either way
Loop
Where kRow is the last row with a value
I need help with an macro to notify me (by changing a cell background color to red), when the value (always number format) changes in any cells in the row. I want the background of cell E3 to change to red, if any of the values in cells F3:AN3 change from their current values.
The numbers in cells F3:AN3 will be entered manually or thru copy and paste of the row, and there won't be any formulas. Likewise, if any values in cells F4:AN4 are changed, I would like cell E4 to change to a red background, and so on for each of the rows in the chart. Not all rows will always have a value, so I would be looking for changes from "" to any #, or from one # to another #, or from any # to "". Ideally this would be an event macro that does not have to be run manually.
The following is the code I've started working with:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F3:AN3")) Is Nothing Then KeyCellsChanged
End Sub
Private Sub KeyCellsChanged()
Dim Cell As Object
For Each Cell In Range("E3")
Cell.Interior.ColorIndex = 3
Next Cell
End Sub
However, this macro seems to run regardless of whether the number in the cell is changed, as long as I press enter it highlight E3 as red.
Any help is much appreciated!
Here is my favorite way to detect changes in an Excel VBA app:
Create an exact copy of the range you're watching in hidden rows below the range the user sees.
Add another section below that (also hidden) with formulas subtracting the user range with the hidden range with an if statement that sets the value to 1 if the difference is anything but 0.
Use conditional formatting in the user range that changes the background color of the row if the corresponding change-detection row (or cell) is > 0.
What I like about this approach:
If a user makes a change and then reverts back to the original value, the row is "smart enough" to know that nothing has changed.
Code that runs any time a user changes something is a pain and can lead to problems. If you set up your change detection the way I'm describing, your code only fires when the sheet is initialized. The worksheet_change event is expensive, and also "may effectively turn off Excel’s Undo feature. Excel’s Undo stack is destroyed whenever an event procedure makes a change to the worksheet." (per John Walkenbach: Excel 2010 Power Programming)
You can detect if the user is navigating away from the page and warn them that their changes will be lost.
Depending on your answer to my question in the comments, this code may change. Paste this in the relevant Worksheet code area. For this to work, navigate to any other sheet and then navigate back to the original sheet.
Option Explicit
Dim PrevVal As Variant
Private Sub Worksheet_Activate()
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
PrevVal = Selection.Value
Else
PrevVal = Selection
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
On Error GoTo ExitGraceFully
If Selection.Rows.Count = 1 And Selection.Columns.Count = 1 Then
PrevVal = Selection.Value
Else
PrevVal = Selection
End If
ExitGraceFully:
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub
Dim aCell As Range, i As Long, j As Long
On Error GoTo Whoa
Application.EnableEvents = False
If Not Intersect(Target, Columns("F:AN")) Is Nothing Then
If Target.Rows.Count = 1 And Target.Columns.Count >= 1 Then
Range("E" & Target.Row).Interior.ColorIndex = 3
ElseIf Target.Rows.Count > 1 And Target.Columns.Count = 1 Then
i = 1
For Each aCell In Target
If aCell.Value <> PrevVal(i, 1) Then
Range("E" & aCell.Row).Interior.ColorIndex = 3
End If
i = i + 1
Next
ElseIf Target.Rows.Count > 1 And Target.Columns.Count > 1 Then
Dim pRow As Long
i = 1: j = 1
pRow = Target.Cells(1, 1).Row
For Each aCell In Target
If aCell.Row <> pRow Then
i = i + 1: pRow = aCell.Row
j = 1
End If
If aCell.Value <> PrevVal(i, j) Then
Range("E" & aCell.Row).Interior.ColorIndex = 3
End If
j = j + 1
Next
End If
End If
LetsContinue:
Application.EnableEvents = True
Exit Sub
Whoa:
Resume LetsContinue
End Sub
SNAPSHOTS
It works as expected When you type a value in the cell. It also works when you copy 1 Cell and paste it in multiple cells. It doesn't work when you copy a block of cells and do a paste (I am still working on this)
NOTE: This is not extensively tested.
I am trying to write a code which basically looks at rows 13-33 and deletes the entire row if the cells in Columns B-M are all Blank AND column A is NOT blank.
The first code which I have written below deletes the entire row only if the cell in Column B is blank but I need all the cells in B-M to be blank in order to delete the entire row.
Sub scheduleA()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Sheets("Schedule A Template").Select
Dim RowstoDelete As Long
x = 33
For RowstoDelete = Cells(x, 2).End(xlUp).Row To 13 Step -1
If (Cells(RowstoDelete, 2).Value = "0") And (Cells(RowstoDelete, 1).Value <> "") Then
Rows(RowstoDelete).Delete Shift:=xlUp
End If
Next RowstoDelete
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
I tried writing it differently as well in the following code but can't achieve the desire result.
Sub DeleteRows()
Dim i As Integer
For i = 33 To 13 Step -1
If WorksheetFunction.CountA(Range("B" & i, "M" & i)) = 0 And WorksheetFunction.CountA(Range("A" & i)) <> "" Then
Rows(i).EntireRow.Delete
End If
Next i
End Sub
Please help!
Your conditions for row deletion are: column A not blank, columns B to M blank. Then something like this should do the trick:
Sub ScheduleA()
On Error GoTo errHandler
Const TOP_ROW As Long = 13
Const BOTTOM_ROW As Long = 33
Dim rowIndex As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
With ThisWorkbook.Worksheets("Schedule A Template")
For rowIndex = .Cells(BOTTOM_ROW, "A").End(xlUp).Row To TOP_ROW Step -1
If Not IsEmpty(.Cells(rowIndex, "A").Value2) Then '...column A is not blank.
If Application.WorksheetFunction.CountA(.Range(.Cells(rowIndex, "B"), .Cells(rowIndex, "M"))) = 0 Then '...all cells on row rowIndex from columns B to M are blank.
.Rows(rowIndex).Delete Shift:=xlUp
End If
End If
Next
End With
Cleanup:
On Error Resume Next
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
errHandler:
MsgBox Err.Description, vbExclamation + vbOKOnly, "Error"
Resume Cleanup
End Sub
Note that the .Select is gone; you almost never have to select anything to get the job done. Not relying on the selection will make your code much more robust. In the code above, the With block tells the code within it to refer to the target worksheet whenever an expression starts with a period, such as .Cells.
Also, when turning off ScreenUpdating and Calculation, systematically include error handling to turn them back on. This way, if something goes wrong, your code won't leave Excel in an undesirable state.
Finally, instead of referring to worksheets by their tab's name (as seen from Excel), you can refer to them directly using their CodeName, as seen from the VBA editor, in the Properties window, under the worksheet's (Name) property (press Ctrl+R to show the Project Explorer, click on the worksheet under the Microsoft Excel Objects node, then press F4 to display the Properties window). You can change this value; I'd typically change it to shtScheduleATemplate. Then, the With line could be re-written as:
With shtScheduleATemplate
...which would still work even after you changed the worksheet's name from Excel.
EDIT: in your question's code, you are checking column B when determining at which bottom row index to start the loop. However, by doing so, you may miss some rows that should be deleted. I've changed my answer to check within column A instead:
For rowIndex = .Cells(BOTTOM_ROW, "A").End(xlUp).Row To TOP_ROW Step -1
I have tried about 20 different codes, trying to edit them to meet my specifications but have failed.
I have a spreadsheet of data. One column titled "Complete" will either have a date or not have a date (mm/dd/yyyy).
I am trying to write a code for using the ToggleButton to hide and unhide rows with date and leave it alone if there is no date.
Please Try This.
Assuming Your Dates are in Column E.
Private Sub ToggleButton1_Click()
Dim LastRow As Long, c As Range
Application.EnableEvents = False
LastRow = Cells(Cells.Rows.Count, "E").End(xlUp).Row
If ToggleButton1.Value = True Then
'This area contains the things you want to happen
'when the toggle button is depressed
For Each c In Range("E1:E" & LastRow)
If c.Value = "" Then
c.EntireRow.Hidden = True
End If
Next
Else
'This area contains the things you want to happen
'when the toggle button is not depressed
ActiveSheet.Range("E1:E" & LastRow).EntireRow.Hidden = False
End If
End Sub
EDIT 27-06-2016
Modified the program slightly to meet OP's requirement.
Private Sub ToggleButton1_ClickRV()
Dim LastRow As Long, c As Range
Application.EnableEvents = False
LastRow = Cells(Cells.Rows.Count, "E").End(xlUp).Row
If ToggleButton1.Value = True Then
'This area contains the things you want to happen
'when the toggle button is depressed
For Each c In Range("E1:E" & LastRow)
If c.Value <> "" Then
c.EntireRow.Hidden = False
End If
Next
Else
'This area contains the things you want to happen
'when the toggle button is not depressed
ActiveSheet.Range("E1:E" & LastRow).EntireRow.Hidden = True
End If
End Sub