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
Related
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.
My main goal is to be able to autofilter merged cells in one column.In the picture below I want row 7-9 to disappear when I remove "6" from the autofilter menu. But as I have figured, I need the value "6" to be held in all the cells "L7:L9" in order for Excel to do so.
The number 6 is calculated by adding "Num1" and "Num2" (2 * 3) by the following function I have placed in "L7":
Function Exposure(arg1 As Range, arg2 As Range) As Variant
Application.EnableEvents = False
Application.Calculation = xlManual
If Application.ThisCell.Offset(, -1).Value <> "-" And Application.ThisCell.Offset(, -2).Value <> "-" Then
Exposure = Left(Application.ThisCell.Offset(, -1).Value, 1) * Left(Application.ThisCell.Offset(, -2).Value, 1)
End If
If Exposure = 0 Then Exposure = "-"
Application.Calculation = xlAutomatic
Application.EnableEvents = True
End Function
I put the following formula inside the merged cell "L7":=Exposure(K7;J7). Then formula is dragged down."Num1" and "Num2" are controlled by valdiation fields, drop-down menu.
My plan was to unmerge after calculating the Exposure Variant, fill the same value in the remaining rows, then re-merge the same area. So I wrote this stand alone Sub:
Sub WorkingSub(rng As Range)
'Set rng = ActiveCell.MergeArea
rng.UnMerge
For i = 2 To rng.Cells.Count
rng.Cells(i).Value = rng.Cells(1).Value 'This line triggers recursion
Next i
rng.Offset(rng.Cells.Count).Copy 'Copies format from below
rng.PasteSpecial Paste:=xlPasteFormats 'Paste that keeps the values even after merging
End Sub
Which works on its own, but not when called inside the function above. After setting the first value, the function triggers "something", debug show the the function starting over, skipping the rng.PasteSpecial Paste:=xlPasteFormats code.
So my question to you guys is how do i write my function(s) to stop "recursing" and let me unmerge during the function call?
Or am I attacking this the wrong way? What would you do?
I am stuck with merged cells for lots of reasons, this is just one part of many inside this spreadsheet.
An interesting problem. You can capture the filter event through trapping a change in a calculation and then processing the rows of the table for visibility. I've made some assumptions for the initial table range assignment which may need some alteration.
The If Not VisRange Is Nothing Then is actually redundant as the prior line will throw a fit if an empty range is assigned, but I just kept it in. In order to get around having a null range, keep the header range in the initial MergedTableRange so there will always be a row visible
Within a cell either somewhere in the same worksheet or a 'dummy' worksheet
=SUBTOTAL(103,Sheet1!A3:H10) 'Or other table range
In the worksheet module code
Private Sub Worksheet_Calculate()
Dim ws As Worksheet: Set ws = Worksheets("Sheet1")
Dim MergedTableRange As Range: Set MergedTableRange = ws.Range("A2").CurrentRegion
Dim Cell As Range
Dim VisRange As Range: Set VisRange = MergedTableRange.SpecialCells(xlCellTypeVisible)
If Not VisRange Is Nothing Then
For Each Cell In VisRange
If Not Application.Intersect(Cell.MergeArea, VisRange).Address = Cell.MergeArea.Address Then
Cell.Rows.Hidden = True
End If
Next Cell
End If
End Sub
I came up with a different approach. Maybe there's a downside I'm missing. But my few test runs have succeeded.
I allready have a hidden sheet named "Template" where the formats for each new "#" is stored. So whenever the user wants to insert a new row, the template have the merged and the non-merged cells ready and insert is done through copy paste.
In that same sheet I made 2 merged rows in column 2, 3 merged cells in column 3 and so on:
This way I'm able to copy the correct number of merged rows to paste after filling the unmerged rows with their correct values.
I came to the conclusion that I could catch a Worksheet_change on the "Num1" and "Num2" columns instead of catching and canceling an autofilter call.
So I added:
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("J:J")) Is Nothing Then
Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
If Not Intersect(Target, Target.Worksheet.Range("K:K")) Is Nothing Then
Call UnMergeMerge(Cells(Target.Row, "L").MergeArea)
End If
End Sub
And the UnMergeMerge sub ended up being:
Sub UnMergeMerge(rng As Range)
Application.EnableEvents = False
Application.ScreenUpdating = False
rng.UnMerge
For i = 2 To rng.Cells.Count
rng.Cells(i).Value = rng.Cells(1).Value
Next i
With Sheets("Template")
.Range(.Cells(8, rng.Cells.Count), .Cells(8 + rng.Cells.Count, rng.Cells.Count)).Copy
End With
rng.PasteSpecial Paste:=xlPasteFormats
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Still not sure it's the fastest and best approach...Do you guys still believe catching, undoing and running a different autofilter would be more effective?
I tried searching for a solution to my XLookup via VBA problem but I couldn't find one. I have this below data set:
In the Data Set, If any cell in the range C2:C6 is blank, I want to use this formula =IF(ISBLANK(B2),"",XLOOKUP(B2,A:A,IF(ISBLANK(D:D),"",D:D))) in those cells. Where row number of B2 is variable depending upon the row we are putting this formula via VBA.
If any cell in the range C2:C6 has value, I want to use that value without any formula. And if someone deletes the value and the cell becomes blank, VBA will add above formula to that cell.
Currently in the screenshot above, all the cells in range C2:C6 has above formula.
I hope I made sense. If this is not doable, it's okay. I can always use a helper column. But I think VBA would be a more cleaner way for my Dashboard.
Many Thanks in Advance.
In the sheet's class module, put this code
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rCell As Range
For Each rCell In Me.Range("C2:C6").Cells
If IsEmpty(rCell.Value) Then
Application.EnableEvents = False
rCell.FormulaR1C1 = "=IF(ISBLANK(RC[-1]),"""",xlookup(RC[-1],C[-2],IF(ISBLANK(C[1]),"""",C[1])))"
Application.EnableEvents = True
End If
Next rCell
End Sub
This will run every time something on the sheet changes. That can't slow things down so you don't want to try to do too much in the Change event. It does not fire on calculate, though.
This one seems to be working for any set of data. Thanks to everyone for the help:
Private Sub InsertFormula()
Dim mwRng As Range
Set mwRng = Range("C2:C250")
Dim d As Range
For Each d In mwRng
If d.Value = "" Then
d.Formula = "=IF(RC[-1]="""",""-"",INDEX(C[1],MATCH(RC[-1],C[-2],0)))"
End If
Next d
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Me.Range("C2:C250")) Is Nothing Then
Application.EnableEvents = False
Call InsertFormula
Application.EnableEvents = True
End If
End Sub
I'm still fairly new to excel but I can just about work out some simple formulas. I'm looking to create a placeholder text effect. The way I want to achieve this is like so;
Cell A1 : has the place holder text and is hidden.
Below this, cell B1 containing the formula.
This formula checks to see if Cell C1 is blank if C1 is blank it returns a value to C1. That value being the value of A1.
This is what I have in my head but I'm unsure on how to code this. I have bounced around the web for a while but I can't find a specific answer. The closest I have gotten is;
=IF(C6<>"","",C4)
Just to clarify Im looking to oput the result of formula B1 into C1.
OK, so put this in the worksheet's code module. Make sure you put it in the module for the specific sheet you're monitoring.
First, fill your range C5 through C99 with the formula like =$C$1. You should only need to do this one time, the macro will take care of it later.
Private Sub Worksheet_Change(ByVal Target As Range)
'the formula reference
Dim defaultFormula As String
defaultFormula = "=$C$1"
'The default text cell:
Dim defaultText As Range
Set defaultText = Range("C1")
'The cells you want to monitor:
Dim rng As Range
Set rng = Range("C5:C999") '## Modify as needed
'Cell iterator
Dim cl As Range
If Intersect(Target, rng) Is Nothing Then Exit Sub
'Avoid infinite looping
Application.EnableEvents = False
'If the user has deleted the value in the cell, then replace it with the formula:
For Each cl In Intersect(Target, rng)
If Trim(cl.Value) = vbNullString Then
cl.Formula = defaultFormula
End If
Next
'Turn on Events:
Application.EnableEvents = True
End Sub
What this does is (hopefully) pretty self-explanatory from the comments in the above code The Change event is raised any time a cell on the worksheet is changed.
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.