I have two columns of data that is pulled into a worksheet from data on other sheets elsewhere in the workbook via a formula in each cell...
The first column, Column A, has either a Yes, No or is blank from data that is pulled in via a formula from another sheet.
The second column, Column B, also has data pulled in from elsewhere but every row has data in it.
What I hope to do is hide any rows that does not have anything in column A. Any rows with data in column A should be visible. I'd like this to be updated via the worksheet_change event using VBA when data is entered that appears in column A.
Many thanks if you can help.
Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Me.Range("A:A")) Is Nothing Then Exit Sub
Application.EnableEvents = False
dim lrow as Integer
dim i as Integer
lrow = Cells(1, 2).End(xlDown).Row
For i = 1 To lrow
If Cells(i, 1) = 0 Then
Rows(i).Select
Selection.EntireRow.Hidden = True
End If
Next
Application.EnableEvents = True
End Sub
You have to insert this on the code of the sheet. right click the sheet name and press the view code and save it as macro enable.
It gets activated when changes have done to column a.
Related
I am running a partially randomize set of data and trying to find the best solutions depending on certain parameter changes. I need to "record" certain solutions and then compare different results for different parameters each time the randomized variables are recalculated.
I would like to do the to following:
On Sheet1, cell S255, is the result of a formula =SUM(M252:S252)
I need to automatically add that result (Sheet1 S255), to Sheet5, column A, starting at A1.
Then, each time the formula is recalculated and the result changes, I need the new result to be added to the consecutive row to the previous result (so the second result would go to A2, third one to A3, and so on).
Looking for similar cases I have come to be able to do 1. and 2. using this event:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Sheet5") 'declare and set the worksheet the data is to be copied into, amend the sheet name as required
If Target.Address = "$S$255" Then 'if anything changes in C6 or C9 in this sheet
ws.Range("A1").Value = Target.Parent.Range("S255") 'copy the value from cell C10 in this sheet to Sheet2 in cell E5
End If
End Sub
Doing 3. is proving more challenging. What event would be suitable to do so?
Thanks in advance for your time and understanding!
Thats how you are able to solve it with the Worksheet_Calculate event like BigBen suggested. Under "Random numbers" are just a few numbers with the RANDBETWEEN-Function for showing puposes. Just change the code for your case. Everytime you press "Delete" for exaple the new sum will be set under the Results column.
Private Sub Worksheet_Calculate()
Dim lastRow As Long
'EnableEvents must be switched off so that the macro does not
'call itself in an endless loop by cell change
Application.EnableEvents = False
lastRow = WorksheetFunction.CountA(Range("C:C")) + 1
Range("C" & lastRow).Value = Range("A9").Value
Application.EnableEvents = True
End Sub
'example saving sum ONLY IF SUM CHANGES
Private Sub Worksheet_Calculate()
Dim offsetLastSum As Long, curSum As Double
offsetLastSum = Range("NEXT_SUM_OFFSET").Value2
curSum = Range("THE_SUM").Value2
With Range("SUM_HISTORY_HEAD")
If .Offset(offsetLastSum - 1).Value2 <> curSum Then
Application.EnableEvents = False
.Offset(offsetLastSum).Value2 = curSum
Application.EnableEvents = True
End If
End With
End Sub
I am trying to create add some code to my macro to add a blank row whenever the value in column "B" is blank. I have the following code, but it is not doing what I want it to. It is entering too many blank rows.
Columns("B:B").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Insert
Sheets("Attendance Audit Hastus").Protect
Any ideas of how I can accomplish this?
If there are four adjacent/consecutive blank cells like B4:B7, the code in the question will insert four rows above them. Try this. It will insert only one row below the blank cells. So the new row will be B8 if the blank cells are B4:B7
Sub InsertOneRowBelowBlankCells()
Dim BColBlnk As Range, ar As Range
Set BColBlnk = Range("B:B").SpecialCells(xlCellTypeBlanks)
For Each ar In BColBlnk.Areas
ar.Cells(ar.Rows.Count, 1).Offset(1).EntireRow.Insert
Next
End Sub
EDIT
And if you want one row above the blank cells, replace ar.Cells(ar.Rows.Count, 1).Offset(1).EntireRow.Insert with ar.Cells(1, 1).EntireRow.Insert
For inserting two rows above the blank cells as per comment below
Sub InsertOneRowBelowBlankCells()
Dim BColBlnk As Range, ar As Range
Set BColBlnk = Range("B:B").SpecialCells(xlCellTypeBlanks)
For Each ar In BColBlnk.Areas
ar.Cells(1, 1).Resize(2, 1).EntireRow.Insert
Next
End Sub
In order to get all cells in column "B" until the last one, you can do this:
Last_Cell_In_B = Columns("B:B").SpecialCells(xlCellTypeLastCell).Row
Range("B1", "B" & Last_Cell_In_B).Select
Like this, you only add empty rows inside your array, not outside of it.
Your code works perfectly in a standard module, so I think you are trying to use its in a event case, in sheet "Attendance Audit Hastus" right? So you need to double click in your sheet icon in project tree and put this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim cell As Range
Dim MRange As Range
Set MRange = Range("B:B")
If Not Intersect(Target, MRange) Is Nothing Then
For Each cell In Target
MRange.SpecialCells(xlCellTypeBlanks).Select
Next cell
End If
Application.EnableEvents = False
Selection.EntireRow.Insert
Application.EnableEvents = True
End Sub
Note the Application.EnableEvents = False is used here to prevent prevent an infinite loop of cascading events. After the action you need to set Application.EnableEvents = True to return your normal process.
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'm having a hard time trying to find a macro for the following use:
Taking in consideration this example:
Consider that i have in the "sheet 1" the table with the columns Country and Food with its values.
In the sheet 2, i have two columns named Country#1 and Food#1. The macro i want, needs to autofill the Food#1 cell that is associated with the right text in Country#1 cell, via the drop down list.
Example: When i select "Madrid" in Country#1, it needs to autofill the Food#1 with the text "Tapas and tortillas".
I'm sorry if this is a re-post question, but i didn't saw anything close as this :|
Best regards,
Luís
You need a Sheet Change Event like below...
The following code assumes that you have a list of Countries and their food in column A and B respectively on Sheet1 and the country dropdown list is in column A on Sheet2.
Right click the Sheet2 Tab --> View code --> Past the following code into the opened code window.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.CountLarge > 1 Then Exit Sub
Dim wsSource As Worksheet
Dim r As Long
Set wsSource = Sheets("Sheet1") 'Source sheet which contains a table of countries and their food
If Target.Column = 1 And Target.Row > 1 Then
If Application.CountIf(wsSource.Columns(1), Target.Value) > 0 Then
Application.EnableEvents = False
r = Application.Match(Target.Value, wsSource.Columns(1), 0)
Target.Offset(0, 1) = wsSource.Cells(r, 2)
Application.EnableEvents = True
End If
End If
End Sub