Hide rows based on multiple cells - vba

I need to hide rows in excel based on the value of multiple cells in the same row. If my row contains all 0's or is blank I need it hid. If there is any integer (not 0 or neg) I need the row shown. On the same sheet I have 'section headers' that separate sections, and below that, a row of blanks. Can I leave those intentional blanks in? I've had a few partially working lines written out, I just can't get it all together.
Hope this make sense and thanks for any help!
Edit: Now if I have a hidden column I'd like for the 'sum' to disregard the hidden column. I've tried nesting something inside RowanC's answer but no go.
For Each myRow In hideRange.Rows
For Each cell In hideRange.Cells
If cell.Columns.Hidden = False Then
Total = Total + cell.Value
End If
Next
If Total = 0 Then 'if the sum of the row=0 then hide
myRow.EntireRow.Hidden = True
End If
Next

My quick go at it:
Sub rowHider1()
Dim hideRange As Range
Dim myRow As Range
Set hideRange = Sheets(2).Range("A2:D12") 'you must set this to apply to the range you want (you could use active selection if you wanted)
hideRange.Rows.EntireRow.Hidden = False 'unhide any rows currently hidden
For Each myRow In hideRange.Rows
If Application.WorksheetFunction.Sum(myRow) = 0 Then 'if the sum of the row=0 then hide
myRow.EntireRow.Hidden = True
End If
Next
End Sub
to take this a step further, and if a column is hidden, don't include it in the sum, moving away from worksheetFunction sum:
Sub rowHider()
Dim hideRange As Range
Dim myRow As Range
Dim cell As Range
Dim bob As Double
Set hideRange = Sheets(2).Range("A1:G12") 'you must set this to apply to the range you want (you could use active selection if you wanted)
hideRange.Rows.EntireRow.Hidden = False 'unhide any rows currently hidden
For Each myRow In hideRange.Rows
bob = 0
For Each cell In myRow.Cells()
If cell.EntireColumn.Hidden <> True Then
Debug.Print cell.Address & " " & cell.Value
bob = bob + cell.Value
End If
Next
If bob = 0 Then 'if the sum of the row=0 then hide
myRow.EntireRow.Hidden = True
End If
Next
End Sub

Related

Hiding or displaying columns and rows inside a table (not sheet) in excel using VBA nad input values of a text-based drop down list

I'm programming a table to display rows based on numeric values in one cell and text values in another (a drop down list). I completed the code for the rows, but can't seem to get my head around the columns.
Edit: What I'm trying to do is display one or two of many columns depending on what input value I have in a dropdown. At the same time as the number of rows displayed are dependent on another cell. E.g. if I have three types of candy, one per column. And in the rows I display how many of said candies I eat per day. I want to display only one of the candies, for x days. How do I code this? The row-part I solved, the column - i need help.
This is my current code, how should I go about solving my predicament?
Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
If Not Intersect(Target, Range("Time_horizon")) Is Nothing Then
TH_row_update
TH_column_update
End If
End Sub
Public Sub TH_row_update()
Dim cell As Range
For Each cell In Range("Time_horizon_Year")
If cell.Value >= ActiveSheet.Range("Time_Horizon") Then
cell.EntireRow.Hidden = True
ElseIf cell.Value <= ActiveSheet.Range("Time_Horizon") Then
cell.EntireRow.Hidden = False
End If
Next cell
Application.ScreenUpdating = True
End Sub
Public Sub TH_column_update()
Dim cell As Range
For Each cell In Range("comparator_range")
If cell.Value = ActiveSheet.Range("Combination_comparators") Then
cell.EntireColumn.Hidden = True
ElseIf cell.Value <= ActiveSheet.Range("Combination_comparators") Then
cell.EntireColumn.Hidden = False
End If
Next cell
Application.ScreenUpdating = True
End Sub
If you want to go trough colums and cells:
For Each col In Range("comparator_range").Columns
Debug.Print "column " & col.Address
For Each cel In col.Cells
Debug.Print " - cell " & cel.Address
Next cel
Next col
So lets say your range is A1:C5
The first for each will run for each column that exists in this range mean A B C
The second for each trough every cell inside of the colum, means A1-A5, B1-B5, C1-C5
Hope this help you already, if you need more informations just tell it.

How can you detect text entry throughout multiple sheets and manipulate cells below it?

I am trying to figure out how to add some cell values together from different sheets but I don't know what the cells references are as they vary!
Basically the values i need will appear 2 rows below some certain text. So I was looking for a formula that searches multiple sheets, finds the specific text, goes 2 rows below then adds the values together.
Here's something I hope you can adapt to your situation by changing the sheet and row and column range, the text to look for, and the destination of the total.
Sub findfvalues()
Dim rowValue
Dim total
total = 0
For r = 1 To 25 'update this to suit your needs
For c = 1 To 25 'update this to suit your needs
If Cells(r, c).Value = "f" Then 'update "f" to search for what you want
rowValue = r + 2
total = total + Cells(rowValue, c).Value
End If
Next
Next
Cells(30, 1).Value = total 'update this to suit your needs
End Sub
So we just check every cell for the "f" and if we find it, we add the value to a running total. Display the total at the end.
This will look in each worksheet, and if your text is found, add the value that's two rows below to a running total:
Sub find_Values()
Dim ws As Worksheet
Dim findStr As String
Dim foundCell As Range
Dim total As Long
findStr = "my Text"
For Each ws In ActiveWorkbook.Worksheets
Set foundCell = ws.Cells.Find(what:=findStr)
If Not foundCell Is Nothing Then
total = total + foundCell.Offset(2, 0).Value
End If
Next ws
Debug.Print "The value is: " & total
End Sub

Hide the whole row when a range of cells is empty

I have a range of cells B2:AB40.
If every cell in each row within the the range is blank (by which I mean no text or numbers, just colour fill and border formatting), I want to hide the whole of the row using a macro.
e.g.
If every cell in the range B2:AB2 is blank then hide all of row 2.
If every cell in the range B3:AB3 is blank then hide all of row 3
If every cell in the range B4:AB4 is blank then hide all of row 4..etc etc etc
Up to and including row 40.
N.B. Each cell in column A and AC in every row adjacent to the specified range will always have text (someone's name and a formula result respectively) and this cannot be changed.
I have seen various ways of doing this based on a single cell but cannot seem to adapt them for my purposes.
Any help is appreciated.
Consider:
Sub RowHider()
Dim I As Long, wf As WorksheetFunction
Set wf = Application.WorksheetFunction
For I = 2 To 40
If wf.CountA(Range("B" & I & ":AB" & I)) = 0 Then
Rows(I).Hidden = True
Else
Rows(I).Hidden = False
End If
Next I
End Sub
Note the usage of a worksheet function in VBA.
Try this
Sub HideRangeIfEmpty()
If Application.WorksheetFunction.CountA(Range("b2:AB2")) = 0 Then
Range("b2:AB2").EntireRow.Hidden = True
End If
End Sub

VBA - Changing row shading when a column value changes even with filtered

I'm trying to write a macro to change the colors of rows when the values in column B change. Column A will be my controlling column using 1's and 0's, i.e. column A will stay a 1 as long as column B stays the same; whenever B changes, A will flip to a 0, and so on.
I can get it to color the rows correctly when the values in column B change, but the problem arises when I filter the data. For example: let's say I have B2-B4 set to "test1", B5-B7 set to "test2", and B8-B10 set to "test3", then I filter column B to not include "test2". Originally, the rows would be colored differently where the column values changed, but rows B2-B4 and B8-B10 are set to the same color and now they're touching since the "test2" rows are hidden.
Here's the code I used to color the rows, but it doesn't work for filtering:
Sub ColorRows()
Dim This As Long
Dim Previous As Long
Dim LastRow As Long
Dim Color As Integer
Dim R As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
RwColor = Array(15,0)
Color = 0
For R = 2 To LastRow
This = Cells(R, 1).Value
Previous = Cells(R - 1, 1).Value
If This <> Previous Then Color = 1 - Color
Range("A" & R & ":M" & R).Select
Selection.Interior.ColorIndex = RwColor(Color)
Next R
End Sub
How can I fix it so that even after filtering the rows are colored correctly when there is a change in column values?
Here's a way to do this:
1.) Insert the code below as a UDF in a code module.
2.) Then put the formula in A, as A2: =analyseVisible(B2).
This will compare B-cells to the next visible cell above and result in a 'rank'-counter in A.
Now that the counter in A in contiunous (even if rows are hidden), you can use MOD 2 to color it with conditional formatting:
3.) Add a conditional format (from A2 for the whole table): =MOD($A2,2)=1 and set the fill color.
If you use the filter now or change values in B, the rows are re-colored in realtime.
Public Function analyseVisible(r As Range) As Integer
Dim i As Long
If Application.Caller.Row <= 2 Or _
r.Row <> Application.Caller.Row Then
analyseVisible = 1
Exit Function
End If
i = r.Row - 1
While r.Worksheet.Rows(i).Hidden And i > 1
i = i - 1
Wend
If i = 1 Then
analyseVisible = 1
Else
analyseVisible = r.Worksheet.Cells(i, Application.Caller.Column).Value
If r.Worksheet.Cells(i, r.Column).Value <> _
r.Value Then analyseVisible = analyseVisible + 1
End If
End Function
The code below handles the issue by checking only the used & visible rows. It works pretty well, but I was unable to figure out how to fire it when the filter changes. It also does it's comparisons directly on the values that are changing.
Private Sub colorRows()
Dim this As Variant
Dim previous As Variant
Dim currentColor As Long
Dim rng As Range 'visible range
Dim c As Range ' cell
' pick a color to start with
currentColor = vbYellow
' rng = used and visible cells
Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
For Each c In rng ' For each cell that is visible and used
If Not c.Row = 1 Then ' skip header row
this = c.Value
'some simple test logic to switch colors
If this <> previous Then
If currentColor = vbBlue Then
currentColor = vbYellow
ElseIf currentColor = vbYellow Then
currentColor = vbBlue
End If
End If
'set interior color
c.Interior.color = currentColor
previous = this
End If
Next c
End Sub
Then, in the module of the worksheet that you want to colorize, call the sub from the Worksheet_Activate() event. (In reality, you probably want a different event. I mostly work with Access, so I don't really know what's available to you. I'm just trying to point you in the right direction to what I'm sure is your next question if you stick with the method you started with.)
Private Sub Worksheet_Activate()
colorRows
End Sub

Excel: Omitting rows/columns from VBA macro

With some help, I've put together two functions that will work in unison to first convert all of my data from the "text" format to a "number" format. After which it will set each column to a fixed number of characters.
The two sub-routines I'm using are listed below, but I can't figure out how to omit certain rows/columns for the respective functions.
When running the psAdd function, I want to omit the first 3 rows from the range, and for the FormatFixedNumber function I want to omit several columns. The problem with the latter is that I have 1000+ columns of data and a key header row containing a 1 or 0 that represents whether the column should be converted.
How could modify this code to skip the first 3 rows in the first sub, and several columns marked with a 0 in the second?
Sub psAdd()
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
Set z = Cells
Set x = Range("A65536").End(xlUp).Offset(1)
If x <> "" Then
Exit Sub
Else
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal
End Sub
Sub FormatFixedNumber()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To lastCol 'replace 10 by the index of the last column of your spreadsheet
With Columns(i)
.NumberFormat = String(.Cells(2, 1), "0") 'number length is in second row
End With
Next i
Application.ScreenUpdating = True
End Sub
1. First code
At the moment you are working on all the cells on a sheet with z. You can reduce this to the UsedRange - ignoring the first three rows by
forcing the UsedRange to update before using it (to avoid redunant cells)
testing if the z exceeds 3 rows
if so resize z by three rows using Offset and Resize
Sub psAdd()
Dim x As Range 'Just a blank cell for variable
Dim z As Range 'Selection to work with
ActiveSheet.UsedRange
Set z = ActiveSheet.UsedRange
If z.Rows.Count > 3 Then
Set z = z.Cells(1).Offset(3, 0).Resize(z.Rows.Count - 3, z.Columns.Count)
End If
'using Rows is better than hard-coding 65536 (bottom of xl03 - but not xl07-10)
Set x = Cells(Rows.Count,"A").End(xlUp).Offset(1)
If x <> "" Then
Exit Sub
Else
x.Copy
z.PasteSpecial Paste:=xlPasteAll, Operation:=xlAdd
Application.CutCopyMode = False 'Kill copy mode
End If
x.ClearContents 'Back to normal
End Sub
2. Second code
Run a simple test on each header cell to proceed if it doesn't equal 0. Assuming that the header cell is in row 1 then
Sub FormatFixedNumber()
Dim i As Long
Application.ScreenUpdating = False
For i = 1 To lastCol 'replace 10 by the index of the last column of your spreadsheet
If Cells(1, i) <> 0 Then
With Columns(i)
.NumberFormat = String(.Cells(2, 1), "0") 'number length is in second row
End With
End If
Next i
Application.ScreenUpdating = True
End Sub