I want to click a button and take cell E27 value and paste it into cell E35.
Then, when I click it again, I want cell E27 value pasted into cell E36.
Then, I want E27 value pasted into cell E37
Basically, E27 is constantly changing and I want to be able to take "Screenshots" of it whenever I want using a macro.
This is the code I have so far. It will paste E27 into E35, but when run again, it doesn't paste E27 into E36 etc.
Sub DataTrend()
Dim inRng As Range, outCell As Range, inCell As Range
Set inRng = Range("E27")
Set outCell = Range("E35")
Application.ScreenUpdating = False
For Each inCell In inRng
outCell.Value = inCell.Value
Set outCell = outCell.Offset(8, 0)
Next inCell
Application.ScreenUpdating = True
End Sub
You would have to provide a method by which the macro can know which row to paste to. There are two systems to choose from.
Determine a location where a counter can be placed: perhaps a cell (on a hidden worksheet) or a custom document property. Each time the button is pressed that counter is advanced by 1, and the row in that counter is used to paste the copy to.
You might arrange your worksheet in such a way that the copy of E27 is always pasted to the next free cell at or below E37. This would do away with the need of a counter but would restrict the use of cells below row 37 in column E.
Your question doesn't specify which system you prefer. The code below chooses the second. It also doesn't require a button. It just records every change made to E27. Condition is that it's installed in the code module of the worksheet on which you want the action.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim Rt As Long ' Target row to write to
With Target
If .Address(0, 0) = "E27" Then
Rt = Application.Max(36, Cells(Rows.Count, "E").End(xlUp).Row) + 1
Cells(Rt, "E").Value = .Value
End If
End With
End Sub
If you prefer to operate the code with a button you can transplant the gist of the procedure to yours and install it in a standard code module, as you have already done.
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
SETUP:
Start with a sheet that has 3 columns. "ID", "MyNote", "MyDate" headers. This sheet may have thousands of rows of data.
I need to "flag" any row where the user has made a change to anything on the row. In other code the flagged rows will be in turn be used to update a table on my SQL server.
Typically there will only be a few rows the user would change/update in a session. So I don't want to process every row in the sheet, particularly the ones with no changes.
WHAT I HAVE WORKING NOW:
I have done this successfully by writing a "x" to an additional "flag" column any time the user makes a change. Then later I can process any rows that were flagged with a "x" . I did this using:
Private Sub Worksheet_Change(ByVal Target As Range)
...
' Flag any lines with a change
If Not Intersect(Target, Me.Range(TestForChangeColRange)) Is Nothing Then
Application.EnableEvents = False
' Set the "Pending Write" Flag
Target.Worksheet.Range(PendingWriteCol & Target.Row).Value = "x"
Application.EnableEvents = True
...
PROBLEM:
That works great for individual cells being updated one at a time. The problem comes when a user either a) uses the drag and copy (drag the bottom right corner of a cell to replicate it where dragged), or b) with a paste from some other workbook, in either case more than one cell is changed at a time.
In those cases, the Worksheet_Change sees only the first cell and not any extra cells edited by dragging or pasting.
I tried to find other similar solutions for intercepting Copy/Paste, etc., but I can't see anyway to find that if a copy was made, which cells were affected.
NEED:
All I need to know is which row numbers were affected from a drag or a copy/paste. If I can accurately flag those rows as updated, I'm in business.
FOLLOW-UP
Using Tim's solution. Having trouble melding something back into it.
Additionally I need to be able to check if a particular column was edited and if it was, clear a different column. For example, if Col 2 is edited, clear the contents of Col 3.
I tried adding the test inside the For loop, but my colno for rw.Col is coming out off.
If Not rng Is Nothing Then
'expand the range so we can flag by row, and not cell-by-cell
Set rng = Application.Intersect(rng.EntireRow, rngTbl)
For Each rw In rng.Rows 'loop over affected rows
Me.Cells(rw.Row, PendingWriteCol).Value = "x"
If rw.Column = RequestTypeCol Then
Me.Cells(rw.Row, LastColToClear).ClearContents
End If
Next rw
End If
Can you show me what I've done wrong?
For example (following on from Scott's comment):
Private Sub Worksheet_Change(ByVal Target As Range)
Const PendingWriteCol As Long = 4
Const TestForChangeColRange = "A:C"
Dim rw As Range, rng As Range, rngTbl As Range
Set rngTbl = Me.Range(TestForChangeColRange)
Set rng = Application.Intersect(Target, rngTbl) 'any monitored cells affected?
If Not rng Is Nothing Then
'expand the range so we can flag by row, and not cell-by-cell
Set rng = Application.Intersect(rng.EntireRow, rngTbl)
For Each rw In rng.Rows 'loop over affected rows
Me.Cells(rw.Row, PendingWriteCol).Value = "x"
Next rw
End If
End Sub
I've got the below code that works well, however I have soo many sub accounts(like "Ads_20_21") that I have to replicate the code many times over and create new named ranges to what is essentially just hiding/unhiding 3 rows below for every sub account. Is there a code that I can assign to a button that will just hide/unhide 3 rows below the active cell, I've tried looking everywhere for help but no luck. Much appreciated for any help.
Sub ToggleHiddenRow(rng As Range)
With rng.EntireRow
.Hidden = Not .Hidden
End With
End Sub
Sub Ads_20_21()
ToggleHiddenRow ActiveSheet.Range("Advertising_20_21")
End Sub
I suggest this code:-
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const TriggerClm As String = "A" ' change to suit
Const FirstDataRow As Long = 2 ' change to suit
Const RowsToHide As Long = 3 ' change to suit
Dim Rng As Range
Set Rng = Range(Cells(FirstDataRow, TriggerClm), Cells(Rows.Count, TriggerClm).End(xlUp))
If Not Application.Intersect(Target, Rng) Is Nothing Then
Set Rng = Range(Rows(Target.Row + 1), Rows(Target.Row + RowsToHide + 1))
Rng.Rows.Hidden = Not Rng.Rows(1).Hidden
Cancel = True
End If
End Sub
It's an event procedure that responds to the double-click event, meaning it runs when you double-click a cell. The event will be taken note of only in the code module of the sheet on which you want the action. Therefore it's essential that the procedure is installed in that module and nowhere else. Because of the special connection this module has to what's happening on the worksheet Excel sets up this module when a tab is created. Use the existing module, not one that you insert yourself.
The 3 constants at the top of the code are for you to adjust. Determine the column you want to double-click, the first data row and the number of rows you want to hide/show, starting from the row below the row you double-clicked. The procedure will not run when you double-click another column or above the first data row. When it runs, it will hide the 3 rows if they are visible or unhide them if they are hidden.
I would look for a way for the program to know when a row is clicked that pertains to a subaccount and skip the action for such rows. If you have such a criterium, establish it in code before If Not Application.Intersect(Target, Rng) Is Nothing Then and then include it in that same line. However, as the code is now, there won't be any big punishment for clicking the wrong row. Undoing the action just takes one double-click.
I want my macro to stop if there's no value entered in any of the four cells I need. But i want it to run if there's at leats one value in those four cells.
This is what i have so far:
If Range("e12,h12,k12,d12").Value = "" Then
MsgBox ("Por favor introducir dimensiones")
Range("e12").Select
Exit Sub
End If
If you introduce a value in cell e12, it will run. But if you introduce a value in any other cell, the msgbox will pop out and the macro will stop.
Could you help me find the problem?
Thank you!
Please install the event procedure below in the code sheet of the worksheet on which you want the action.
Private Sub Worksheet_Change(ByVal Target As Range)
Const Triggers As String = "E12,H12,K12,D12"
Dim Rng As Range
Dim Cell As Range
' skip if more than one cell was changed (like paste)
If Target.Cells.CountLarge = 1 Then
Set Rng = Range(Triggers)
For Each Cell In Rng
If Cell.Value = "" Then
Cell.Select
Exit For
End If
Next Cell
End If
End Sub
Now, if the user enters something in E12 the macro will select H12. If the user enters something in D12 next the macro will take him back to K12. That's all very nice.
But if the user changes something in A3 (anywhere, in fact) he will be taken to the first empty cell of the trigger range. Therefore the system must be tweaked to accommodate your workflow. Perhaps the code should be made to run only when D12 is entered, or when the user clicks on the cell he shouldn't click on before completing the trigger range.
In short, the scope of the procedure may have to be trimmed to suit your workflow. This can be done by either including specific cells in the trigger range, or by excluding other cells.
you coudl use WorksheetFunction.CountA() function to count the number of not empty cells:
If WorksheetFunction.CountA(Range("e12,h12,k12,d12")) <> 4 Then
MsgBox ("Por favor introducir dimensiones")
Range("e12").Select
Exit Sub
End If
When formula result changes in my table in column K range ("K2:K5") I want the entire row in the table to be filled with a color. But I only want the row to be colored if the result is not equal to 0.
So eg. if the result changes in K2 (and is not = 0) the entire row A2:L2 will be colored.
The formula are refering to values that you select from dropdown-lists (created from "data validation" on the excel menu Data-tab). These dropdowns are located on the same row (eg. “D2:J2”) as the related formula. The values in the dropdown is refering to a range on the same sheet outside of the table.
So far I have one code for the worksheet concerning the change event that calls the module with the sub that will change the color on the row.
But it doesn't work and I get no error messages.
This is the code for the worksheet change event:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "§D2:§J2" Then
Color_Row
End If
End Sub
Here the target address should propably be the whole range, but I don't know how to give the right syntax for that.
Here is the code for changing color on row:
Sub Color_Row()
Dim r As Long, c As Long 'r=rows in the excel sheet | c= value of cell in _
column k
Dim numrow As Long 'last row with data
Dim tblR As Long 'tablerow
numrow = TimeMeasure.Range("K" & Rows.Count).End(xlUp).Row
For r = 2 To numrow
tblR = r - 1
c = Cells(r, 11).Value
If c <> 0 Then
[TimeDist].Rows(tblR).Interior.Color = 12961279
Else
[TimeDist].Rows(tblR).Interior.Color = xlNone 'no fill color
End If
Next
End Sub
I have steped in to this code and watched variables like c, r, numrow, tblR and it all seems to match my table (the name of my table is TimeDist).
The only thing that I've noticed is that no values ever assigns to c in the loop. I know though that this code works in another workbook, but then I manualy type in a new value in a specific cell outside of the table, which changes the formula result in table (then the rows get colored)
I very thankfuly accept any help on this.
Many thanks for all your inputs which has helped me to solve it! :)
It now works like a charm!
This worksheet_calculate code does the job (I have changed my cell range though):
Private Sub Worksheet_Calculate()
Dim Xrg As Range
Set Xrg = Range("L2:L5")
If Not Intersect(Xrg, Range("L2:L5")) Is Nothing Then
Color_Row
End If
End Sub