Hiding/unhiding excel sheets based of a matrix - excel

I have a macro that works, but it's not very effective and could be done a lot better.
I simply have a list with all sheet names(they could change so it needs to be dynamic) in one row and in the next row I have a "yes/no" answer that displays if the sheet should be hidden or not.
Example:
Sheet 1, sheet2, sheet3, sheet4,
yes, yes, no, yes
My code so far:
Sub HidingSheets()
'Checking the first sheet
'-------------------------------------------------------------------------------------------
Sheets(Worksheets("Sheet1").Range("E9").Value).Visible = True
Sheets(Worksheets("Sheet1").Range("E9").Value).Activate
If ActiveSheet.Range("A1") = "NO" Then
ActiveSheet.Visible = False
End If
'-------------------------------------------------------------------------------------------
'Checking the second sheet
'-------------------------------------------------------------------------------------------
Sheets(Worksheets("Sheet1").Range("F9").Value).Visible = True
Sheets(Worksheets("Sheet1").Range("F9").Value).Activate
If ActiveSheet.Range("A1") = "NO" Then
ActiveSheet.Visible = False
End If
'-------------------------------------------------------------------------------------------
End Sub
I basically do it manually per every sheet instead of a loop, and this also requires that I need the "yes/no" displayed in every sheet(the "if" formula checking if A1 = "no"). The "yes/no" that s displayed in cell A1 is taken from the matrix that I explained before.
Note: The matrix could be "tranposed", the direction of it doesn't matter.
Thank you in advance if you can help me.
My second attempt is this:
Sub Hiding2()
Dim i As interger
For i = 1 To 10
a = ActiveSheet.Range("E9").Value
If Offset(a(1, 0)) = YES Then
Sheets(a).Visible = True
Else
Sheets(a).Visible = False
End If
Next i
End Sub
But I dont know how to reference the cells that I need, and then get them to move over for every "i".

Sub HideWorksheets()
Dim Cell As Range
Dim Data As Range: Set Data = Worksheets("Sheet1").Range("E9:N9")
On Error Resume Next
For Each Cell In Data
Worksheets(Cell.value).Visible = IIf(Cell.Offset(1, 0) = "YES", xlSheetHidden, xlSheetVisible)
Next Cell
End Sub

You can use Cells instead of Range. With it, you can use column numbers to iterate over some range of columns. There is also other possibilities to exit the code... it depends on the data in your worksheet.
Sub Hiding()
Dim sh as Worksheet, col as Integer
For col = 5 to 100
shName = Worksheets("Sheet1").Cells(9, col).Value
On Error GoTo TheEnd ' in case there is no such sheet
Set sh = Worksheets(shName)
If UCase(sh.Range("A1").Value) = "YES" Then
sh.Visible = xlSheetVisible
Else
sh.Visible = xlSheetHidden
End If
Next col
TheEnd:
End Sub

Related

How to code to fill down a range with the above value?

I am creating a macro where in column B I need to fill and copy down the value above until the next value is found and again it is copied down until the next one and so and so.
Right now I have the following syntaxis:
Range("B:B").CurrentRegion.SpecialCells(xlCellTypeBlanks).FormulaR1C1 = "=R[-1]C"
It is working, but the "currentregion" is creating some data that I do not want. How can I replace that or change my syntaxis to make it work only in column B:B
First things first, be careful with Range("B:B").CurrentRegion - it will not necessarily include everything in column B as my example below shows. Next, this macro will copy cell values down to empty cells. Application.ScreenUpdating will speed it up if the range is large.
Sub CopyDown()
Dim rAll, r As Range
Set rAll = Range("B:B").CurrentRegion
Set r = Range("B2")
Application.ScreenUpdating = False
While Not Intersect(r, rAll) Is Nothing ' ie. r in the "current region"
If IsEmpty(r) Then r.Value = r.Offset(-1).Value ' copy down the value above
Set r = r.Offset(1) ' move down 1 row
Wend
Application.ScreenUpdating = True
End Sub

VBA: Detecting value in cell with dropdown list

I am having some trouble detecting the value in a cell with a dropdown list.
When I am running the below code, it only gives me the value 0 in column I. Column H contains a number of Dropdown lists (made by data validation), which value can either be Yes or No:
Sub DropDownlistValue()
Dim Holidays As Worksheet
Dim Checkbox_RowCount As Long
Dim HolidayCount As Long
Set Holidays = ThisWorkbook.Sheets("Visning")
Checkbox_RowCount = Holidays.Cells(Holidays.Rows.Count, "H").End(xlUp).Row
For HolidayCount = 2 To Checkbox_RowCount
If Not IsEmpty(Holidays.Range("H" & HolidayCount)) Then
Holidays.Activate
Holidays.Range("H" & HolidayCount).Select
If ActiveCell = "YES" Then
ActiveCell.Offset(0, 1) = 1
Else
ActiveCell.Offset(0, 1) = 0
End If
End If
Next HolidayCount
End Sub
Thanks in advance.
What you possibly need is the change in this line:
If ActiveCell = "YES" Then
into
If Ucase(ActiveCell) = "YES" Then
One more tip- move this line:
Holidays.Activate
before/outside your loop.

Consolidating VBA IF, THEN statements that repeat the same logic in a continuous row set

I am a novice when it comes to writing macro code in VBA. I'm working with Excel 2010, and I think I have a simple problem. I want to hide rows in my worksheet that meet the condition of having a zero sum result in column AJ. I was able to figure how to do this for one row and then repeat for each subsequent row, but I know there must a better/more efficient means of writing this. Can anyone help me re-word this code so that it considers the range of rows 8-14 all together rather than considering each row one at a time? This would reduce my run-time and decrease the possibility for errors. Thank you in advance!
Sub Hide_1()
'
' Master Macro
If ActiveSheet.Range("AJ8") = 0 Then
Rows("8").EntireRow.Hidden = True
End If
If ActiveSheet.Range("AJ9") = 0 Then
Rows("9").EntireRow.Hidden = True
End If
If ActiveSheet.Range("AJ10") = 0 Then
Rows("10").EntireRow.Hidden = True
End If
If ActiveSheet.Range("AJ11") = 0 Then
Rows("11").EntireRow.Hidden = True
End If
If ActiveSheet.Range("AJ12") = 0 Then
Rows("12").EntireRow.Hidden = True
End If
If ActiveSheet.Range("AJ13") = 0 Then
Rows("13").EntireRow.Hidden = True
End If
If ActiveSheet.Range("AJ14") = 0 Then
Rows("14").EntireRow.Hidden = True
End If
End Sub
This will loop through your range and hide the row where the value is 0:
Sub HideRows()
Dim rng As Range, cl As Range
Set rng = Range("AJ8:AJ14")
For Each cl In rng
If cl = 0 Then
cl.EntireRow.Hidden = True
End If
Next cl
End Sub
How about:
Public Sub HideEntireRow(cellToCheck As range, valueToHide As Variant)
If cellToCheck.Value2 = valueToHide Then cellToCheck.EntireRow.Hidden = True
End Sub
Public Sub Hide_2()
Dim cell As range
For Each cell In ActiveSheet.range("AJ10:AJ14")
Call HideEntireRow(cell, 0)
Next cell
End Sub
For a range as small as you are working with, an autofilter will not offer any visible performance boost, but you should use autofilters by default rather than loops. There are plenty of instances where loops are necessary, but this doesn't appear to be one of them.
Here is how you can filter your sheet (starting in row 8), hiding any rows that have a 0 in column AJ. Note that I am calculating the last row in your sheet. If you need to hard-code a specific range, you can easily modify this:
Sub FilterZeroRows()
Dim ws As Worksheet
Dim rng As Range
Dim lastRow As Long
Set ws = ThisWorkbook.Sheets("Sheet1")
lastRow = ws.Range("AJ" & ws.Rows.Count).End(xlUp).Row
Set rng = ws.Range("AJ8:AJ" & lastRow)
' keep any rows that don't have 0 visible
rng.AutoFilter field:=1, Criteria1:="<>0"
End Sub

VBA Macro to delete unchecked rows using marlett check

I don't really have much of a background in VBA, but I'm trying to create a macro where, on the push of a button all rows that do not have a check mark in them in a certain range are deleted. I browsed some forums, and learned about a "marlett" check, where the character "a" in that font is displayed as a check mark. Here is the code I have to generate the "marlett check" automatically when clicking a cell in the A column in the appropriate range:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
If Not Intersect(Target, Range("A10:A111")) Is Nothing Then
Target.Font.Name = "Marlett"
If Target = vbNullString Then
Target = "a"
Else
Target = vbNullString
End If
End If
End Sub
I then have another macro (assigned to a button) that actually deletes the rows without a check mark in the "A" column when the button is pressed:
Sub delete_rows()
Dim c As Range
On Error Resume Next
For Each c in Range("A10:A111")
If c.Value <> "a" Then
c.EntireRow.Delete
End If
Next c
End Sub
Everything works, but the only problem is that I have to press the button multiple times before all of the unchecked rows are deleted!! It seems like my loop is not working properly -- can anyone please help??
Thanks!
I think this may be due to how you're deleting the rows, you might be skipping a row after every delete.
You might want to change your for-each for a regular for loop. so you can control the index you'r working on. see this answer or the other answers to the question to see how to do it.
Heres a modified version that should suit your (possible) problem.
Sub Main()
Dim Row As Long
Dim Sheet As Worksheet
Row = 10
Set Sheet = Worksheets("Sheet1")
Application.ScreenUpdating = False
Do
If Sheet.Cells(Row, 1).Value = "a" Then
'Sheet.Rows(Row).Delete xlShiftUp
Row = Row + 1
Else
'Row = Row + 1
Sheet.Rows(Row).Delete xlShiftUp
End If
Loop While Row <= 111
Application.ScreenUpdating = True
End Sub
Update
Try the edit I've made to the if block, bit of a guess. Will look at it when I have excel.
It does go into an infinite loop regardless of the suggested change.
The problem was when it got near the end of your data it continually found empty rows (as theres no more data!) so it kept deleting them.
The code below should work though.
Sub Main()
Dim Row As Long: Row = 10
Dim Count As Long: Count = 0
Dim Sheet As Worksheet
Set Sheet = Worksheets("Sheet1")
Application.ScreenUpdating = False
Do
If Sheet.Cells(Row, 1).Value = "a" Then
Row = Row + 1
Else
Count = Count + 1
Sheet.Rows(Row).Delete xlShiftUp
End If
Loop While Row <= 111 And Row + Count <= 111
Application.ScreenUpdating = True
End Sub

I need to copy several cells from multiple spreadsheets to a summary sheet base on the contents of a third cell in excel

I need to copy the contents of cells A2 to A88 and C2 to C88 based on the contents of what is in cells in column G from several spreadsheets in a workbook to the Summary sheet.
So I need code to scan all spreadsheets to see if the word Case closed is in cell G33 and than copy the contents of cell A33 and C33 to a cell on the summary page.
I have seen several close answers but nothing that does the job.
Sorry no code available.
Thanks for any and all answers.
You could create some vba if you cannot solve this using excel formulas... I made a little test excel sheet with following vba code:
Sub test()
processSheet Application.ActiveWorkbook, "Sheet1"
End Sub
Function FindSheet(currentWorkbook As Workbook, sheetName As String) As Worksheet
If currentWorkbook Is Nothing Then
Err.Raise vbObjectError + 1, "FindSheet", "Supplied workbook is nothing"
End If
Dim idx As Integer
For idx = 1 To currentWorkbook.Sheets.Count
Dim checkSheet As Worksheet
Set checkSheet = currentWorkbook.Sheets.Item(idx)
If checkSheet.Name = sheetName Then
Set FindSheet = checkSheet
Exit Function
End If
Next
End Function
Function IsEmpty(currentCell As Range) As Boolean
IsEmpty = False
If currentCell.Value = "" And currentCell.Value2 = "" Then
IsEmpty = True
End If
End Function
Sub processSheet(currentWorkbook As Workbook, sheetName As String)
On Error GoTo Catch
Dim currentSheet As Worksheet
Set currentSheet = FindSheet(currentWorkbook, sheetName)
If currentSheet Is Nothing Then
Err.Raise vbObjectError + 2, "ProcessSheet", "Could not find sheet " + sheetName
End If
Dim colA As Range
Dim colB As Range
Dim colCondition As Range
Dim colResult As Range
currentSheet.Activate
Set colA = currentSheet.Columns(1)
Set colB = currentSheet.Columns(2)
Set colCondition = currentSheet.Columns(3)
Set colResult = currentSheet.Columns(4)
Dim index As Integer: index = 2
Dim run As Boolean: run = True
Do While run
If IsEmpty(colA.Rows(index)) And IsEmpty(colB.Rows(index)) And IsEmpty(colCondition.Rows(index)) Then
run = False
Else
index = index + 1
If colCondition.Rows(index).Value = "Closed" Then
resultContent = CStr(colA.Rows(index).Value2) + ": " + CStr(colB.Rows(index).Value2)
Else
resultContent = "-"
End If
colResult.Rows(index).Value2 = resultContent
End If
Loop
GoTo Finally
Catch:
MsgBox ("An error occured: " + Err.Description)
Exit Sub
Finally:
End Sub
You can just put this macro in the macros of a new workbook. Open the Sheet1 and add 4 columns. I added a screenshot of how the excel sheet looks like.
As a new user I'm not allowed to post images.. so here is the link: Sheet1
Short explanation of the code.
A workbook is passed and a sheet selected by a sheet name
If the sheet is available the script runs through the three dependent columns (two columns needed for concatenation and one for the condition) and checks if the values are set. The loop stops when all the three columns do not contain any value (in your case you could hardcode the start and end index, if it always stays the same).
During the iteration, the condition field is checked. If it is equals "Closed", the result cell is filled with the first two columns values concatenated.
You certainly need to adapt the code to your problem, but shouldn't be a big thing to do.

Resources