I have a dataset where every row is a General Ledger (GL) account and in each column there is the value for the relevant period.
I would like to hide all GL accounts (rows) where no values (or zero values) are included for all periods (columns).
The code below seems to work for the "No values".
How do I hide all the rows with only zeroes (or all rows with zeroes or "no values"?
If one period has an amount, the row shouldn't be hidden.
Sub hide()
Dim c As Range
For Each c In Range("A1:F6")
If c.Value = "" Then
c.EntireRow.Hidden = True
Else
c.EntireRow.Hidden = False
End If
Next c
End Sub
Furthermore once any amounts change in a row this code should also make the unhidden rows reappear. At this moment it hides a row that has no value, but once this changes, the hidden row doesn't reappear anymore.
See code below if you want to test for both all blanks or all zeros and hide row if either present. Starts with an unhide of all rows.
Sub hide()
Dim wb As Workbook
Dim ws As Worksheet
Dim c As Range
Dim targetRange As Range
Set wb = ThisWorkbook
Set ws = wb.Sheets("Sheet5")
Set targetRange = ws.Range("A1:F6")
targetRange.EntireRow.Hidden = False
For Each c In targetRange.Rows
If (WorksheetFunction.CountIf(c,"<>0") - WorksheetFunction.CountIf(c,"") = 0) And (WorksheetFunction.CountA(c) - WorksheetFunction.Count(c) = 0) Then
c.EntireRow.Hidden = True
End If
Next c
End Sub
You have to check every row completely before deciding if to hide it or not. Currently, the last cell of every row decided if a row is hidden.
Give the following code a try. It sets a range to all cells of a row and uses the function CountA to count number of cells that are not empty.
Sub hide()
Dim ws As Worksheet, row As Long
Set ws = ActiveSheet
With ws
For row = 1 To 6
Dim myRange As Range
Set myRange = .Range(.Cells(row, 1), .Cells(row, 6))
.Rows(row).EntireRow.Hidden = (Application.WorksheetFunction.CountA(myRange) = 0)
Next row
End With
End Sub
Related
Edit: I should clarify what I was trying to do. I have a list of values in column D through H and sometimes I may not have any values in the top most rows (they then equal 0, usually 40 rows or so). I want to make it so I don't have to scroll down to the rows that do have values not equaling zero. So I thought it would be easiest to hide the rows that have values equaling zero. But I have values in column A that I don't want to hide. I didn't realize I couldn't hide rows in a specific column without hiding the whole row. I need to rethink how I want to do this.
Original post: I am new to VBA, please bear with me. I have been copy and pasting different snippets of code, trying to get something to work.
I want to loop through all cells in column D through H and have the cells that equal zero to hide themselves. I plan on reusing this sheet so I want the cells to unhide themselves when the value is above zero again.
Here is my code:
Private Sub Hide_Cells_If_zero()`enter code here`
Dim targetRange As Range, po As Long, i As Long
Set targetRange = Columns("D:H")
po = targetRange.Count
With targetRange
For i = 1 To po
If .Cells(i, 1).Value = 0 Then
.Rows(i).Hidden = True
End If
Next
End With
End Sub
Hide Rows With Criteria
This will hide each row where the value of any cell in columns D:H evaluates to 0.
The Code
Option Explicit
Private Sub Hide_Cells_If_zero()
Dim sRng As Range
Set sRng = Columns("D:H")
Dim tRng As Range
Dim rRng As Range
Dim cel As Range
For Each rRng In sRng.Rows
For Each cel In rRng.Cells
If cel.Value = 0 Then
If Not tRng Is Nothing Then
Set tRng = Union(tRng, cel)
Else
Set tRng = cel
End If
Exit For
End If
Next cel
Next rRng
If Not tRng Is Nothing Then
tRng.EntireRow.Hidden = True
End If
End Sub
I am trying to use find the last row of a merged cell with text and hide all rows beside that
For example:
A1:A5 is a merged cell with text "A", A6:A10 is a merged cell with text "B", etc
I want to write a code that would find the last row of the merged cell with text "B", and would hide any rows above or below the merged cell.
At the moment I am defining the rows to hide manually, but these change frequently so my method is not very efficient.
Any suggestions on how to find the last row instead?
Sub FindLastRow()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Test")
'Hide all rows above B
ws.Rows("1:5").EntireRow.Hidden = True
'Hide all rows below B
ws.Rows("11:80").EntireRow.Hidden = True
End Sub
I guess you could try the following, making use of Range.Find and Range.MergeArea:
Sub Test()
Dim ws As Worksheet: Set ws = ThisWorkbook.Worksheets("Test")
Dim fullRng As Range, fndRng As Range
Set fullRng = ws.Range("A1:A80")
Set fndRng = ws.Range("A1:A80").Find(What:="B", Lookat:=xlWhole)
If Not fndRng Is Nothing Then
fullRng.Rows.Hidden = True
fndRng.MergeArea.Rows.Hidden = False
End If
End Sub
I have a range of cell numbers that I need for multiple worksheet names.
I create multiple worksheets based on the number of rows.
Sub Copier()
Dim x As Integer
x = InputBox("Enter number of times to copy worksheet")
For numtimes = 1 To x
ActiveWorkbook.Sheets("OMRS 207").Copy _
After:=ActiveWorkbook.Sheets("OMRS 207")
Next
End Sub
That grabs only one name, OMRS 207.
I want to generate these worksheets using the entire range of cells in the original worksheet.
Try below code.
Dim data As Worksheet
Dim rng As Range
Set data = ThisWorkbook.Sheets("Sheet1")
Set rng = data.Range("A2")
Do While rng <> ""
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = rng.Value
Set rng = rng.Offset(1, 0)
Loop
I assumed that your data starts from 2nd row in Sheet1 and you want the sheet name as per values in Column A.
If you want row number as sheet name for newly added sheet just use rng.row while assigning name to sheet.
I am trying to set up a procedure that looks up cells in Column "G" and if a value is greater than 1, copy that entire table row, insert a row (as many times - 1 based on the value) and paste that value into each newly inserted row.
So if there is a quantity of 3 in cell "G4" then I would like to copy the row of that cell and insert a row below it 2 times and paste the copied values.
Below is what I have so far...
**Note all of this is in a table in Excel. (not sure if that's part the issue with my code)
Dim Qty As Range
For Each Qty In Range("G:G").cells
If Qty.Value > 1 Then
Qty.EntireRow.cell
Selection.Copy
ActiveCell.Offset(1).EntireRow.Insert
Selection.Paste
Selection.Font.Strikethrough = True
End If
Next
End Sub
There are a number of issues with your approach and code
You say the data is in an Excel Table. Use that to your advantage
When inserting rows into a range loop from the bottom up. This prevents the inserted rows interfering with the loop index
Don't use Selection (and even if you do your logic doesn't manipulate the ActiveCell)
Don't loop over the whole column (thats a million rows). Limit it to the table size
Here's a demonstration of these ideas
Sub Demo()
Dim sh As Worksheet
Dim lo As ListObject
Dim rColumn As Range
Dim i As Long
Dim rws As Long
Set sh = ActiveSheet ' <-- adjuct to suit
Set lo = sh.ListObjects("YourColumnName")
Set rColumn = lo.ListColumns("YourColumnName").DataBodyRange
vTable = rColumn.Value
For i = rColumn.Rows.Count To 1 Step -1
If rColumn.Cells(i, 1) > 1 Then
rws = rColumn.Cells(i, 1) - 1
With rColumn.Rows(i)
.Offset(1, 0).Resize(rws, 1).EntireRow.Insert
.EntireRow.Copy .Offset(1, 0).Resize(rws, 1).EntireRow
.Offset(1, 0).Resize(rws, 1).EntireRow.Font.Strikethrough = True
End With
End If
Next
End Sub
I have a list in excel with about 20000 rows and 4 columns. This excel sheet contains names in bold, and the columns after that have information about them. After each name there is some excess information that takes up either 3 or 4 rows, but it's not consistent. I need to run through the sheet and delete all the rows where there isn't a bold name.
You need to create a macro the finds out how many rows are in the current worksheet and that then iterates through the rows from the bottom of the worksheet to the top checking to see if the Font.Bold property on the first column of the row is set to false. If so you delete that row.
The following works for me:
Sub DeleteUnboldRows()
Dim lastRow As Long
Dim currentRow As Long
'Select All the rows in the active worksheet
lastRow = ActiveSheet.UsedRange.Rows.Count
' Iterate through each row from the bottom to the top.
' If we go the other way rows will get skipped as we delete unbolded rows!
For currentRow = lastRow To 1 Step -1
'Look at the cell in the first column of the current row
' if the font is not bolded delete the row
If ActiveSheet.Rows(currentRow).Columns(1).Font.Bold = False Then
ActiveSheet.Rows(currentRow).Delete
End If
Next currentRow
End Sub
Here is a reference for the Bold property: http://msdn.microsoft.com/en-us/library/office/aa224034%28v=office.11%29.aspx
Sub deleteNonBolded()
Dim cell As Range
Dim selectRange As Range
For Each cell In Intersect(ActiveSheet.Range("A:A"), ActiveSheet.UsedRange)
If (cell.Font.Bold = False) Then
If selectRange Is Nothing Then
Set selectRange = cell
Else
Set selectRange = Union(cell, selectRange)
End If
End If
Next cell
selectRange.EntireRow.Delete
End Sub