I know there are many questions here about hiding and unhiding rows in excel-vba but I can't seem to get my code to work...
I am working on a spreadsheet that has the month's totals listed on top. I want the sheet to hide the row of any month's total that doesn't appear in the sheet.
For ex. if there is no data in the list for January then the January totals row will be hidden. Once someone puts data for january in the list then the row will unhide.
I know that the script won't be running at all times so I added a "month reset" button that would run the script and hide/unhide all appropriate rows.
For some reason, every time I hit the button, the row just disappears regardless of whether or not the data is in the list below. I only wrote the code for January's row so far:
Private Sub CommandButton1_Click()
Sheets("Master Pipeline").Select
For Each cell In Range("B16:B100")
If cell.Value = "January" Then
Range("A3").EntireRow.Hidden = False
Else
Range("A3").EntireRow.Hidden = True
End If
Next
End Sub
Cells A3:A14 have the months listed with their totals in the cells next to them.
Rows 16:100 have the list of data, Column B has the month.
Please help...
Thanks in advance,
LT
You can use the following to hide any months that are missing in the data range. Note that you don't need to (and shouldn't) write code for each month. Also note that finding the value in the range is dramatically more efficient than looping through your data range.
Have your button call this sub:
Sub HideMissingMonths()
Dim ws As Worksheet
Dim months As Range
Dim data As Range
Dim cell As Range
Dim found As Range
Set ws = ThisWorkbook.Sheets("Master Pipeline")
Set months = ws.Range("A3:A14")
Set data = ws.Range("B16:B100")
Application.ScreenUpdating = False
' unhide all months before we begin
months.EntireRow.Hidden = False
For Each cell In months
Set found = data.Find(what:=cell, LookIn:=xlValues)
If found Is Nothing Then cell.EntireRow.Hidden = True
Next cell
Application.ScreenUpdating = True
End Sub
Related
I have a spreadsheet that operators input data in, with the A column being the date, and the data is input by row. The A column is a formula that adds +1 to the date in the previous cell, going all the way down recursively to auto-populate the date as the sheet is filled out.
I have to have a report printed out at the end of every day, and I am trying to use VBA to filter the rows out by a date that the operator inputs on another sheet in cell B2. I need the macro to grab that date value, and pass it as a variable to the filter in order to pull the 12 rows of that date and paste it into a new sheet. Unfortunately, the value it pulls is not being passed, and when I put a MsgBox command in there, it shows it's pulling 12:00 AM and not a date. When using the Date variable, it also breaks the filter on the bottom macro below (trying 2 different versions just to get this working).
I'm not good with VBA, so my macros were pulled from example websites and I tailored them to what I need.
This is one macro I have tried:
Sub For_RangeCopy()
Dim rDate As Date
Dim rSheet As Worksheet
Set rSheet = ThisWorkbook.Worksheets("EOS")
rDate = CDate(rSheet.Range("B2").Value)
MsgBox (rDate)
' Get the worksheets
Dim shRead As Worksheet
Set shRead = ThisWorkbook.Worksheets("Bi-Hourly Report")
Dim shWrite As Worksheet
Set shWrite = ThisWorkbook.Worksheets("Report")
' Get the range
Dim rg As Range
Set rg = shRead.Range("A1").CurrentRegion
With shWrite
' Clear the data in output worksheet
.Cells.ClearContents
' Set the cell formats
'.Columns(1).NumberFormat = "dd/mm/yyyy"
'.Columns(3).NumberFormat = "$#,##0;[Red]$#,##0"
'.Columns(4).NumberFormat = "0"
'.Columns(5).NumberFormat = "$#,##0;[Red]$#,##0"
End With
' Read through the data
Dim i As Long, row As Long
row = 1
For i = 1 To rg.Rows.Count
If rg.Cells(i, 1).Value2 = rDate Or i = 1 Then
' Copy using Range.Copy
rg.Rows(i).Copy
shWrite.Range("A" & row).PasteSpecial xlPasteValues
' move to the next output row
row = row + 1
End If
Next i
End Sub
And here is another Macro I have tried to use. This one actually gives me the 3 header rows which I don't need, but I don't mind, this paste is a reference for the report layout anyway, so the operators won't see this sheet. But this macro does give me the first block of the date range: 1/1/2023. I do know that the "rgCriteria As String" is likely incorrect, but that is how I get anything useful from this macro. If I change that rgCriteria to a Date, it breaks the rgData.AdvancedFilter command, and I haven't learned enough VBA to know why. And my boss wants this done today, although here I am posting here, thus it's not getting done today.
Sub AdvancedFilterExample()
' Get the worksheets
Dim rSheet As Worksheet
Set rSheet = ThisWorkbook.Worksheets("EOS")
Dim shRead As Worksheet, shWrite As Worksheet
Set shRead = ThisWorkbook.Worksheets("Bi-Hourly Report")
Set shWrite = ThisWorkbook.Worksheets("Report")
' Clear any existing data
shWrite.Cells.Clear
' Remove the any existing filters
If shRead.FilterMode = True Then
shRead.ShowAllData
End If
' Get the source data range
Dim rgData As Range, rgCriteria As String
Set rgData = shRead.Range("A1").CurrentRegion
' IMPORTANT: Do not have any blank rows in the criteria range
'Set rgCriteria = rSheet.Range("B2")
rgCriteria = rSheet.Range("B2").Value
MsgBox (rgCriteria)
' Apply the filter
rgData.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=rgCriteria _
, CopyToRange:=shWrite.Range("A1")
End Sub
I don't know which method of filtering and pasting is best for my situation, but I do know that the faster is better. I'm copying entire rows, and it needs to be efficient because this log contains a lot of data. I only need one of these macros to work, but I will be heavily modifying them and chaining them together with about 5 other filter/copy/paste sequences to follow, along with printOut commands after that, and finalized by clearing the sheets it pastes to, and then re-enabling all the functionality of the sheet (calculations, displaystatusbar, events, and screenupdating) all to make it quicker while the macro is running. All of these reports will be run using the macro with a button click.
Any thoughts or suggestions would be greatly appreciated. I've been struggling with this for a couple of weeks now. I'm at a loss and turning to the community that has helped me with a TON of questions over the past 20 or so years just by a Google search!
Other information:
I'm using Office 365 on a Windows 10/11 machine. The headers of the sheet it filters does contain merged cells as the header is rows 1-3, there is a lot of data in this sheet that grows through the year. 12 rows per day for an entire year. These macros are written in a Module aptly named "Module 1" if that helps. I do have this workbook, and the original log saved on OneDrive that can be shared.
When using Advanced Filter your criteria range should have headers which match your data table.
Sub AdvancedFilterExample()
Dim rSheet As Worksheet, shRead As Worksheet, shWrite As Worksheet
Dim rgData As Range, rgCriteria As Range
Set rSheet = ThisWorkbook.Worksheets("EOS")
Set shRead = ThisWorkbook.Worksheets("Bi-Hourly Report")
Set shWrite = ThisWorkbook.Worksheets("Report")
Set rgData = shRead.Range("A1").CurrentRegion 'source data range
'## criteria range needs to include a matching date header...
Set rgCriteria = rSheet.Range("B3:B4") 'eg. "Date" in B3, date value in B4
shWrite.Cells.Clear ' Clear any existing data
If shRead.FilterMode = True Then shRead.ShowAllData ' Remove the any existing filters
rgData.AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=rgCriteria, _
CopyToRange:=shWrite.Range("A1")
End Sub
I'm trying to select the true last cell data set then insert a subtotal into the cell below. Everything I've tried selects the last cell of my visible data. I need the last cell of the entire sheet.
For instance, my filtered data will have rows 3:10 visible. My code is selecting row 10 when I need it to select the last row of the entire dataset that's hidden (row 100).
This will be performed on multiple sheets at once.
Here's my code:
Sub Example()
Dim LastRow As Long
With ActiveSheet
LastRow = .Range("J2").SpecialCells(xlCellTypeLastCell).Row
End With
Call SubTotalMacro
End Sub
Thanks!
Try this:
MsgBox ActiveSheet.UsedRange.Rows(ActiveSheet.UsedRange.Rows.Count).Row
I got help with the below code to get data from Columns A,C:G and J from Source Sheet and put it into Columns A to G in Target Sheet depending on 24th column(X) having a 1 in it in that row. It all works fine, my Target Sheet updates with the correct information from the Source Sheet, however it also deletes all data past Column G. For example if I type 100 in Column J in my Target Sheet when I come back to my Target Sheet next time it's gone. I want to keep the data I have in Columns past Column G.
How can i stop the code below from deleting my data in Columns after Column G? I tried a couple things but my excel goes into a fit as I think I'm creating a loop.
Any help is hugely appreciated.
Private Sub Worksheet_Activate()
Dim Source As Worksheet: Set Source = Sheets("From")
Dim Target As Worksheet: Set Target = Sheets("To")
Application.ScreenUpdating = False
Target.UsedRange.Offset(1).Clear
With Source.[A1].CurrentRegion
.AutoFilter 24, 1
Union(.Columns("A"), .Columns("C:G"), .Columns("J")).Offset(1).Copy
Target.Columns("A:G").End(3)(2).PasteSpecial xlValues
.AutoFilter
End With
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
I have a large spreadsheet of various chemicals and their specifications; however, not every chemical requires a value in each column so there are a lot of blank cells. I'm wondering if there's something I can do to hide a column if there are no values in it when I select it from a drop-down list filter?
For example, I click on the drop-down list and select "potassium hydroxide" and I want it to hide the columns "Moisture" because there are no values in it.
what it looks like now:
I tried using some VBA code earlier but I don't seem to get how to incorporate it into the drop-down list filter.
Unfortunately, there is no Event for a filter being applied/changed to fire off a macro. However, you can manipulate the Event, Worksheet_Calculate, to achieve desired result since modifying a filter calculates the sheet. I.E. every time the sheet calculates, the macro is triggered!
So now we need to link a filter to a calculation. Any equation will do for this so I am just setting K1 = L1 in my example. Ideally, this will be somewhere out of sight (Ideally next to your last used column header to avoid hiding columns not being used)
The macro is making use of the Aggregate function by counting the instances of non-empty cells for visible rows only. When a filter is applied, any columns that only have 1 visible cell will be hidden. We are using 1 as a base line since all columns will at least have 1 visible cell due to header.
Paste the below code in VBE on sheet Specifications. This will not work in a module or workbook template.
Option Explicit
Private Sub Worksheet_Calculate()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Specifications")
Dim LCol As Long: LCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
On Error GoTo SafeExit
Dim HeaderCell As Range
Application.ScreenUpdating = False
Columns.EntireColumn.Hidden = False
Rows.EntireRow.Hidden = False
For Each HeaderCell In ws.Range(ws.Cells(1, 1), ws.Cells(1, LCol))
If Application.WorksheetFunction.Aggregate(3, 7, HeaderCell.EntireColumn) = 1 Then
HeaderCell.EntireColumn.Hidden = True
End If
Next HeaderCell
SafeExit:
Application.ScreenUpdating = True
End Sub
TLDR
Make sure Sheet has at least 1 equation. When you apply/modify a filter, you force a calculation. When you force a calculation, you trigger the macro. When you trigger the macro, you hide all columns that only have 1 visible cell (which will be the header).
If this runs slow, you can add your range to a Union of columns and hide the Union (all columns meeting your criteria) once loop is complete.
Much in the line of #urdearboy, I'd go as follows
place the following formula in any cell in row 1:
=SUBTOTAL(3,A:A)
then place the following code in the "Specification" sheet code pane:
Private Sub Worksheet_Calculate()
Dim col As Range
With Me.UsedRange
For Each col In .Offset(, 1).Resize(, .Columns.Count - 1).Columns
col.EntireColumn.Hidden = Application.WorksheetFunction.Subtotal(103, col) = 1
Next
End With
End Sub
as you may notice, since the same chemical can appear more than one in in column A (e.g.: "Sulfamic Acid"), a column gets hidden only if all of its visible cells are empty
try this code:
For i = 1 To 500
If Application.WorksheetFunction.Count(Columns(i)) = 1 Then
ActiveSheet.Columns(i).Hidden = True
End If
Next
I have a large number of helper rows taking information from a different sheet using a simple sum function:
=SUM('HIS-WOT'!J36,'HIS-WOT'!J82,'HIS-WOT'!J128)
Is there a macro out there that will allow me to change/offset all the row numbers in a number of selected cells by an equal amount (i.e. 221) to get a formula such as:
=SUM('HIS-WOT'!J257,'HIS-WOT'!J333,'HIS-WOT'!J349)
The amount with which I need to change the various row numbers varies, so the macro would need to have a dialogue box allowing the user to choose by how much the user wants to increase or decrease row numbers.
Thanks!
This code will give create a dummy sheet to copy the formulas over, I liked your question!
Sub test()
Dim nbr As Long, cel As Range, cels As Range, sh As Worksheet
Set cels = Selection
nbr = CLng(InputBox("Enter offset:"))
Set sh = Worksheets.Add
For Each cel In cels
If cel.HasFormula Then
sh.Cells(cel.Row + nbr, cel.Column).FormulaR1C1 = cel.FormulaR1C1
cel.Formula = sh.Cells(cel.Row + nbr, cel.Column).Formula
End If
Next
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
End Sub