Find all cells changed with paste or drag - excel

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

Related

Not able to change values in rows in Pivot Table

I have a problem concerning Pivot Tables. If you create a Pivot Table where you drag some variables to "Rows" and some to "Values", then it is not possible to change any of data concerning the values column. For example, if I try to change the value of "Average of Final Product Value" to something else I am thrown an error:
However, it is possible to change any of the data in the Row Labels but it is not possible to delete it completely. For an example, I changed "Cheeku" to "a".
Is there any way to make sure that you can't change the Row Labels in Excel? I made some VBA which does the job, i.e. it looks at a certain range and then by using Worksheet_Change I can undo what was just done. However, I would like to just do it in Excel - if it is possible. My code is
Sub Worksheet_Change(ByVal Target As Range)
Dim WatchRange As Range
Dim IntersectRange As Range
Dim nRow As Integer
Dim temp As Variant
With Sheets("Sektor")
nRow = .Cells(21, 1).End(xlDown).row
End With
Set WatchRange = Range("A21:D" & nRow)
Set IntersectRange = Intersect(Target, WatchRange)
If IntersectRange Is Nothing Then
'Do Nothing Spectacular
Else
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End If
End Sub
To do it in Excel I tried to lock the rows, which did not work. Any suggestions?
Normally you can edit the name of the column headers in your pivot table.
I see that you have the yellow bar at the top. I don't speak the language but I assume that it's the usual yellow bar that appears when you can't edit the file and you actually have to press the button to go in "Edit mode".
Regarding stopping users from editing the row of the Pivot Table, your idea of locking the rows is correct.
The only issue is that you need to "Protect" the sheet for the locking to take effect.

VBA Hide/Unhide 3 rows below active cell

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.

How to make Formula give multiple results across other cells

So I'm working on an excel sheet, and this is something i really can't figure out.
I want it to be that if the contents of a cell match certain criteria, an entire column of cells will be pasted according to that cell. The cell is a drop down with 32 different options (that can be reduced if theres no way to do it) and each option corresponds to a different column of data. The columns that have to be pasted have roughly 32 cells of data each.
My current formula is basically =IFS(A1="Potato",Sheet2!G:G) but this gives me a '0'. The best i can do is change the formula to =IFS(A1="Potato",Sheet2!G1) or =IFS(A1="Potato",Sheet2!G1:G32) but both of these formulas give me the contents of the first cell only (G1).
Any ideas on how I could get this done without having to contact aliens or build a spaceship?
You can use formulas, or VBA.
I have assumed your 32 columns of source data are in Sheet2 with the headers in row 1.
Formula Solution
In Sheet1 A73, enter:
=INDEX(Sheet2!$A$1:$AF$41,ROW(A1),MATCH($A$1,Sheet2!$A$1:$AF$1,0))
Copy this formula to Sheet1 A74:A105
VBA Solution
Put this code in the Sheet1 module;
Private Sub Worksheet_Change(ByVal Target As Range)
Dim c As Range
If Not Intersect(Target, Range("A1")) Is Nothing Then
Application.EnableEvents = False
With Sheet2
Set c = .Rows(1).Find(what:=Sheet1.Range("A1").Value)
If Not c Is Nothing Then
Set c = Intersect(.UsedRange, c.EntireColumn)
Sheet1.Range("A73").Resize(c.Rows.Count, 1).Delete
c.Copy Sheet1.Range("A73")
End If
End With
Application.EnableEvents = True
End If
End Sub
EDITED ANSWER: (according to comment)
We have the following layout of products
Private Sub CommandButton1_Click()
'first we check the user input
Dim u_input As String
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
u_input = LCase(Trim(ws.Range("A1").Value2))
'now we need to determine how many columns there are so we know when to stop looping
Dim lc As Long, lr As Long
lc = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
' loops through all the products
For Each cell In Range(Cells(1, "F"), Cells(1, lc))
' if the product matches the input
If LCase(Trim(cell)) = u_input Then
lr = ws.Cells(ws.Rows.Count, cell.Column).End(xlUp).Row
' copy and paste the active data range to A37
ws.Range(Cells(1, cell.Column), Cells(lr, cell.Column)).Copy
Sheets("Sheet2").Range("A37").PasteSpecial
End If
Next cell
End Sub
So, upon entering cucumber and clicking the button:
We would get the following result:
You can add any number of products there, as long as the first product starts in column F. (though that can also be changed in code).
PS: This will however end up overwriting your data and also cause data to overlap if your data ranges are not the same. It probably would be smarter to paste the data into the next empty row in sheet2 instead of directly to A37
This can be achieved by changing the line
Sheets("Sheet2").Range("A37").PasteSpecial to Sheets("Sheet2").Range(Cells((Rows.Count, "A").End(xlUp).Row, "A")).PasteSpecial

How do I change a cell value dependant on a drop-down event?

I have almost found the answer to this in previous post, but not quite.
The scenario is as follows.
Column A contains values, based on a drop down list.
When I change a value - on any row in column A - I want the current date to be written into to the corresponding row in column C. The date must not change when I save and re-open the file at a later point, i.e. the =TODAY() function won't do it.
The user might change a multiple values on different rows in column A before exiting and saving the file.
Thankful for any input.
Mårten.
This should meet your needs, paste this vba code into the Microsoft Excel Object for the worksheet you desire (so if this is for Sheet1, paste it into Sheet1):
Private Sub Worksheet_Change(ByVal Target As Range)
Dim controlRng, nRng As Range
'This will be the entire range of drop downs you have, I've set it to be the entire column A, if that's not suitable then change it to a set range
Set controlRng = Range("A:A")
Set nRng = Intersect(controlRng, Target)
If nRng Is Nothing Then Exit Sub
If Target.Value <> "" Then
Target.Offset(0, 2).Value = Now
End If
End Sub

Excel VBA - how to check for non-blank values in hidden range

I'll start by making my objective clear, and then explaining it fully.
My goal is to check for non-blank values in a range, but only in the hidden cells of that range, and then use conditional formatting in a different cell, depending on whether the cells in the range are empty or not.
I have a named range called Location_Address_RangeCheck that covers the cells directly to the right of the location numbers, like this (location numbers are not part of the range).
When the Number of Locations is changed, the rows that go beyond that number (up to 25) are automatically hidden on worksheet_change to reduce clutter and reduce scrolling to see the stuff below it. That code works fine, so I'm not posting it here so as to not confuse anyone with what I'm trying to accomplish.
I want to provide a safeguard to ensure that there aren't values in the hidden rows that could affect outputs (i.e., if someone selects "3" for Number of Locations, but there is data in cells that might be on the row of the 8th location).
My goal is to check for non-blank values in the range, but only in the hidden cells, and then use conditional formatting in the cell next to the number of locations chosen, depending on whether the cells in the range are empty or not.
So if there is data in the hidden cells, then it would cause the sheet to look like this
.
I've tried so many different things so far, but I'm not making any progress. I've scoured the internet trying to find a solution, but everything I've found is about finding things in visible cells, which is the opposite of what I'm trying to achieve.
Here is the code I have written so far, which I know does not achieve my objective:
Sub testhiddencells()
Dim myRange As Range
Set myRange = Range("Location_Address_RangeCheck")
NumRows = Application.WorksheetFunction.CountA(myRange)
If Range("Location_Address_RangeCheck").Hidden = True Then
If Application.WorksheetFunction.CountA(Range("Location_Address‌​_RangeCheck")) <> 0 Then
MsgBox "There's something there"
End If
End If
End Sub
Here is a minimal example to check with a cell is both hidden and is non-empty:
Option Explicit
Sub Test()
Dim ws As Worksheet
Dim rngToCheck As Range
'test range - all cells populated with 'a' and 3 are hidden
Set ws = ThisWorkbook.Worksheets("Sheet1")
Set rngToCheck = ws.Range("A1:A7")
If TestForNonBlankCellsInHiddenRange(rngToCheck) Then
'do you conditional format stuff here
End If
End Sub
Function TestForNonBlankCellsInHiddenRange(rngToCheck As Range) As Boolean
Dim rngCell As Range
Dim blnCheck As Boolean
'assume that hidden cells are blank
blnCheck = False
'iterate range
For Each rngCell In rngToCheck
If rngCell.EntireRow.Hidden And Not IsEmpty(rngCell.Value) Then
'found a hidden and non-empty cell
blnCheck = True
'debug address of this cell
Debug.Print rngCell.Address
End If
Next rngCell
'return check
TestForNonBlankCellsInHiddenRange = blnCheck
End Function
Looking at the code you used already, you should be able to adapt this to the particular use case of your worksheet.

Resources