Concatenating values in target column - vba

I'm having troubles with a VBA code: There's an Excel sheet (Sheet1) that contains two essential columns (last & first name)
What I am trying to do is, that whenever you add another last and first name to the list, both of them automatically get concatenated in another sheet and form a new list (start position for that list is Sheet11.Range("AB3"), on position AB2 is the list title "Clients").
My code therefore was entered in Sheet1:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim tmp As Range
For Each tmp In Sheet1.Range("C4:C100")
If tmp.Value <> "" And tmp.Offset(0, 1).Value <> "" Then
Sheet11.Cells(Cells(Rows.Count, "AB").End(xlUp).Row + 1, "AB").Value = tmp.Value & " " & tmp.Offset(0, 1).Value
End If
Next tmp
End Sub
Unfortunately, as soon as I enter first & last names while this code is active, the concatenated names are not listed one after another, but the last name in the list replaces the list title in AB2.
I guess the problem lies somewhere within the loop process, but I can't seem to figure out the logic behind it. I'd be thankful for any suggestions to solve that problem!

The problem is that the following instruction
Sheet11.Cells(Cells(Rows.Count, "AB").End(xlUp).Row + 1, "AB").Value
returns the same cell each time the loop is repeated. You can replace this whole line for example by this:
Range("AB" & tmp.Row).Value = tmp.Value & " " & tmp.Offset(0, 1).Value

Whenever you use a Worksheet_Change event macro to change the values of cell on the same worksheet, you need to turn off event handling or the value change will trigger a new event and the Worksheet_Change will try to run on top of itself. This also holds true for other worksheets that contain a Worksheet_Change unless you want the change in value to force the event. Similarly, the Target can represent more than a single cell (e.g. a paste operation) so you need to deal with the individual cells in the Intersect, not the Intersect as a whole.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Columns("B:C")) Is Nothing Then
On Error GoTo bm_Safe_exit
Application.EnableEvents = False
Dim bc As Range
For Each bc In Intersect(Target, Columns("B:C"))
Sheet11.Cells(bc.Row, "AB") = _
Join(Array(Cells(bc.Row, "B").Value2, Cells(bc.Row, "C").Value2))
Next bc
End If
bm_Safe_exit:
Application.EnableEvents = True
End Sub
I've used the Join Function as the string concatenation mechanism. While any character can be supplied as a connector in a Join, the default is a space.

I suggest a faster Change event - you don't need to loop over all rows for every update
This will add new entries and update existing ones:
Private Sub Worksheet_Change(ByVal Target As Range)
With Target
If .CountLarge = 1 And .Row >= 3 And (.Column = 3 Or .Column = 4) Then
Dim cel As Range
Set cel = Cells(.Row, 3)
If Len(cel) > 0 And Len(cel.Offset(0, 1)) > 0 Then
Worksheets("Sheet11").Range("AB" & .Row) = cel & " " & cel.Offset(0, 1)
End If
End If
End With
End Sub

Related

Excel VBA: How to create macro to change text color using if statement

This is a continuation for the following question: What is the cause for Conditional Formatting to get jumbled up?
In an attempt to prevent my conditional formatting from going haywire, I decided to convert it into code in VBA. I decided to start small and start with converting one conditional formatting into VBA.
Explanation:
In column O there are a series of numbers, obtained from a different sheet. User inputs number in column F. For example if number in F9 is less than O9, the font colour will become red. If not number remains normal. The formula should start at row 9 and can continue down onwards and should be automatic.
Meaning the moment a number is keyed in column F the font colour should change instantly.
The following is the code I created so far:
Sub change_color()
With Me.Range("f9", Range("f" & Rows.Count).End(xlUp)) 'so the formula will carry onwards from f9 onwards
If f9 < o9 Then
Range(f).Font.Color = vbRed
End If
End With
End Sub
But alas it didn't work. I also tried linking it to a button and nothing happens. And I also remember to remove my old conditional formatting as well. Is there something I'm missing?
You are after something like the code below.
This code is to be ran once, it will lopp through the entire column "F" in your worksheet, and change the font of all instances.
Regular Module Code
Option Explicit
Sub change_color()
Dim LastRow As Long, i As Long
With Worksheets("Sheet1") ' modify to your sheet's name
LastRow = .Cells(.Rows.Count, "F").End(xlUp).Row
For i = 1 To LastRow
If .Range("F" & i).Value < .Range("O" & i).Value Then
.Range("F" & i).Font.Color = vbRed
Else
.Range("F" & i).Font.Color = vbBlack
End If
Next i
End With
End Sub
To "catch" the modification in real-time, when someone changes a value in column "F", and then change the font according to the criteria you specified, you need add the following code to the Worksheet module, where you have your data, and add the piece of code below to Worksheet_Change event.
Code in Sheet1 module (modify to your sheet's)
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 6 Then ' if someone changes a value in column "F"
Application.EnableEvents = False
If Target.Value < Range("O" & Target.Row).Value Then
Target.Font.Color = vbRed
Else
Target.Font.Color = vbBlack
End If
End If
Application.EnableEvents = True
End Sub
Does this work for you?
Option explicit
Sub ChangeColor()
With thisworkbook.worksheets(YOURSHEETNAME) 'Replace with sheet name as per your workbook.'
Dim LastRow as long
Lastrow = .cells(.rows.count,"F").end(xlup).row
Dim RowIndex as long
For rowindex = 9 to LastRow
If .cells(rowindex,"F").value2 < .cells(rowindex,"O").value2 then
.cells(rowindex,"F").font.color = vbred
End if
Next rowindex
End With
End Sub

Excel to copy matching cell row from tabs to a summary tab in the same workbook

I have a workbook and I need to find the NO values on ROW G (Row 7) and then copy the line that NO belongs to a new sheet (TAB) called summary, in my case it is listed as sheet 18.
I need to search on all sheets though from Sheet 1 to Sheet 17 in their G Rows for NO's.
I have a code I have found online and amend it to work with my criteria. But it does not seem to work as I would like it to it keeps coming up with errors.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Dim nxtRow As Integer`enter code here`
'Determine if change was to Column G (7)
If Target.Column = 7 Then
'If Yes, Determine if cell = NO
If Target.Value = "NO" Then
'If Yes, find next empty row in Sheet 18
nxtRow = Sheets(18).Range("F" & Rows.Count).End(xlUp).Row + 1
'Copy changed row and paste into Sheet 18
Target.EntireRow.Copy _
Destination:=Sheets(18).Range("A" & nxtRow)
End If
End If
End Sub
Thank you in advance.
Vasilis.
http://s38.photobucket.com/user/Greekcougar/media/screenshot9_zpslhtkkfue.jpg.html
http://s38.photobucket.com/user/Greekcougar/media/sub%20macro_zpsngyjtsj9.jpg.html
Below is the code for the same. It has two sub procedures initiate and applyFilterAndCopy. In initiate you can specify the no. of sheets(sheetCount In below code I have mentioned as 2) you need to scan. While calling the second sub procedure inside first(initiate) you need to specify the column number and the text you are searching for as variables to the second sub procedure(Call applyFilterAndCopy(i, 1, "No") here I have mentioned as 1 i.e. 1st column and String to be searched as No in quotes). Please note the sheet names need to be in the format Sheet**** and summary sheet name as Summary case sensitive as mentioned in your description.
Sub initiate()
Worksheets("Summary").UsedRange.Delete
Dim i As Integer, sheetCount As Integer
sheetCount = 2
For i = 1 To sheetCount
Call applyFilterAndCopy(i, 1, "No")
Next i
End Sub
Sub applyFilterAndCopy(sheetNo As Integer, searchInColumn As Integer, textToSearch As String)
Worksheets("Sheet" & sheetNo).AutoFilterMode = False
Worksheets("Sheet" & sheetNo).Range("A1").AutoFilter Field:=searchInColumn, Criteria1:=textToSearch
DR = Worksheets("Summary").UsedRange.SpecialCells(xlCellTypeLastCell).Row
If IsEmpty(DR) = True Or DR = 1 Then
Worksheets("Sheet" & sheetNo).UsedRange.SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Summary").Range("A1")
Else
Worksheets("Sheet" & sheetNo).UsedRange.Offset(1, 0).SpecialCells(xlCellTypeVisible).Copy _
Destination:=Worksheets("Summary").Range("A" & DR + 1)
End If
End Sub
Vba is not necessary for this. An easy way to do this is using a formula and filter.
Add a column to the sheet that looks at the previous row and checks if no is there. Then filter this column and you can then just copy and paste to your summary tab.

How to get Excel Spreadsheet to auto populate date & time using VBA?

Trying to get a macro enabled worksheet on Excel to auto populate date and time when any values are entered in column B or C.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
For i = 2 To 100
If Cells(i, "B").Value <> " " And Cells(i, "C").Value = " " Then
Cells(i, "F").Value = Date & " " & Time
Cells(i, "F").NumberFormat = "m/d/yyyy h:mm AM/PM"
End If
Next
Range("F:F").EntireColumn.AutoFit
End Sub
is there anything wrong with the code I'm writing?
You don't want to run through all of that everytime anything on the worksheet changes; only when something that affects the validity of the timestamp changes. Typically, we would use Intersect to determine if one of the values that changed should receive a new timestamp. You also do not want the routine to attempt to run on top of itself so turning event handling off before changing a value (i.e. adding the time stamp) is recommended.
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("B:C")) Is Nothing Then
On Error GoTo SafeExit
Application.EnableEvents = False
Dim bc As Range 'no sense in declaring something until we actually need it
For Each bc In Intersect(Target, Range("B:C")) 'deal with every cell that intersects. This is how to handle pastes into more than one cell
If Not IsEmpty(Cells(bc.Row, "B")) And Not IsEmpty(Cells(bc.Row, "C")) Then
Cells(bc.Row, "F").Value = Now 'Now is the equivalent of Date + Time
Cells(bc.Row, "F").NumberFormat = "m/d/yyyy h:mm AM/PM"
End If
Next bc
'Range("F:F").EntireColumn.AutoFit 'this slows things down. you may want to comment this out and just set an apprpriate column width that will handle everything
End If
SafeExit:
Application.EnableEvents = True
End Sub
That is my take on this old problem. There are many examples. Look toward the Related section down the right-hand side of this page for links to a few.
"Target" will be the cell(s) that changed. It is possible to change more then one cell at a time (via ctrl-enter) so checking all cells in the Target isn't a bad idea.
If you use the Intersect method it will get only the area of Target and the range you wanted to check that overlaps. This will then loop through those cells (if there are any) and if a value is found, timestamp them.
As others have mentioned, disabling events before you plug the stamps will prevent calling another worksheet change event. Just be careful when debugging not to leave events off.
You can read more about the event parameters here: https://msdn.microsoft.com/en-us/library/office/ff839775.aspx
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Excel.Range
Dim cll As Excel.Range
Set rng = Excel.Intersect(Target, Range("B:C"))
If Not (rng Is Nothing) Then
Excel.Application.EnableEvents = False
For Each cll In rng.Cells
If Len(cll.Formula) > 0 Then
Cells(cll.Row, 6).Value = Format$(Now, "m/d/yyyy h:mm AM/PM")
End If
Next
Range("F:F").EntireColumn.AutoFit
Excel.Application.EnableEvents = True
End If
End Sub
Couple of small changes:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim i As Integer
Application.EnableEvents = False
If Target.Column = 2 Or Target.Column = 3 Then
For i = 2 To 100
If Cells(i, "B").Value <> " " And Cells(i, "C").Value = " " Then
Cells(i, "F").Value = Date & " " & Time
Cells(i, "F").NumberFormat = "m/d/yyyy h:mm AM/PM"
End If
Next
End If
Range("F:F").EntireColumn.AutoFit
Application.EnableEvents = True
End Sub
Turn the even off so you don't fire it when your code makes a modification and test the target column to see if it is B or C and only fire if it is
Also, you know your code will update rows 2 to 100 regardless of which row was changed right? If you only want the row that was changed you can get that with target.row

Text to speech in Excel visual basic macro

I've been trying to write a macro in excel that can recognize changing values of a column of cells and trigger an alert using text to speech for the corresponding row different column. Below are two sets of code I've used and have produced results, however I need to finetune the code as I've run into a few obstacles:
the first code updates too frequently (each time there is an external update to the sheet, fires off this code).
Sub Worksheet_Calculate()
Dim myText As String
For Each c In Range("bf4:bf45")
If c.Value = 1 Then
myText = c.Offset(0, -57).Text
Application.Speech.Speak (myText)
End If
Next
End Sub
the second code fires off only when I manually hit the enter key in the range defined.
Sub worksheet_change(ByVal target As Range)
If target = 1 And _
target.Column = 58 And _
target.Row >= 4 And _
target.Row <= 45 Then _
Application.Speech.Speak target.Offset(0, -57).Text
End Sub
I am trying to add code that can either provide a timer for this code ( so every 4 minutes the text to speech alert will go off) or each time the defined column's values change there will be an auto text to speech alert of corresponding row.
Thanks!
Edited to include code of worksheet calculate and code for .ontime
Sub Worksheet_Calculate()
Dim myText As String
For Each c In Range("bf4:bf45")
If c.Value = 1 Then
myText = c.Offset(0, -57).Text
Application.Speech.Speak (myText)
End If
Next
End Sub
Public Sub Updatetextspeech()
'Clock that prompts running of text to speech alert
Sheets("ALERTS").Select
Call myText
Nexttick = Now + TimeValue("00:03:00")
Application.OnTime Nexttick, "Updatetextspeech"
If Time >= TimeValue("16:00:00") Then
Application.OnTime Nexttick, "Updatetextspeech", , False
End If
End Sub
Additional code updated 9/12/2014 in response to DavidZemens code
Option Explicit
Dim oldValues As Variant
Dim rng As Range
Sub Main()
'## Define our range to monitor, modify as needed
Set rng = Sheets("ALERTS").Range("be4:be45")
'## Store its values in the array
oldValues = rng.Value
'## Initialize the UpdateTextSpeech
' I use a shorter interval for debugging, modify as needed
Application.OnTime Now + TimeValue("00:00:10"), "UpdateTextSpeech"
End Sub
For some reason below section of the code sub "updatetextspeech" is causing alot of breaks, of the different code I tried I would either get object not defined, or compile errors, or argument not optional below are the few different codes for the application.speech I tried
Sub UpdateTextSpeech()
Dim r As Long
**'## Iterate the range**
For r = 1 To rng.Rows.Count
'Check if its value has changed AND the adjacent cell
If rng.Cells(r, 1).Value <> oldValues(r, 1) And rng.Cells(r, 1).Offset(0, 1).Value = 1 Then
**'This is where your speech app goes:**
Application.speech.speak.cells(r,1).text 'OR
Application.speech.speak.value.text 'OR
Application.speech.speak (updatetextspeech).text 'OR
End If
Next
'Provide a way to escape the OnTime loop:
If MsgBox("Continue monitoring cell changes?", vbYesNo) = vbYes Then
'update the "old" values
oldValues = rng.Value
Application.OnTime Now + TimeValue("00:00:10"), "Updatetextspeech"
End If
End Sub
Let's try something like this.
First, declare a module-level variable to represent the range of cells you want to monitor, and also their values can be stored as a module level variant.
We'll initially store the values. Then we start our timer loop using Application.OnTime method. Each interval we will compare the current values to the values stored at the last interval. If the value has changed and if the formula equals 1, then you can do the speech. A prompt will ask the user if s/he wants to continue. If yes, then we store the new values in the variant and those will be compared against the next interval.
I use a shorter interval, and a message box instead of the speech application, but you should be able to modify this.
Option Explicit
Dim oldValues As Variant
Dim rng As Range
Sub Main()
'## Define our range to monitor, modify as needed
Set rng = Sheets("ALERTS").Range("A2:A10")
'## Store its values in the array
oldValues = rng.Value
'## Initialize the UpdateTextSpeech
' I use a shorter interval for debugging, modify as needed
Application.OnTime Now + TimeValue("00:00:10"), "UpdateTextSpeech"
End Sub
Sub UpdateTextSpeech()
Dim r As Long
'## Iterate the range
For r = 1 To rng.Rows.Count
'Check if its value has changed AND the adjacent cell
If rng.Cells(r, 1).Value <> oldValues(r, 1) And rng.Cells(r, 1).Offset(0, 1).Value = 1 Then
'This is where your speech app goes:
MsgBox rng.Cells(r, 1).Address & " has changed." & vbCrLf & vbCrLf & _
"Old value: " & oldValues(r, 1) & vbCrLf & _
"New value: " & rng.Cells(r, 1).Value
End If
Next
'Provide a way to escape the OnTime loop:
If MsgBox("Continue monitoring cell changes?", vbYesNo) = vbYes Then
'update the "old" values
oldValues = rng.Value
Application.OnTime Now + TimeValue("00:00:10"), "Updatetextspeech"
End If
End Sub

Determine whether user is adding or deleting rows

I have a VBA macro that validates user entered data (I didn't use data validation/conditional formatting on purpose).
I am using Worksheet_Change event to trigger the code, the problem I am facing now is, when there are row changes. I don't know whether it is a deleting / inserting rows.
Is there anyway to distinguish between those two?
You could define a range name such as
RowMarker =$A$1000
Then this code on your change event will store the position of this marker against it's prior position, and report any change (then stores the new position)
Private Sub Worksheet_Change(ByVal Target As Range)
Static lngRow As Long
Dim rng1 As Range
Set rng1 = ThisWorkbook.Names("RowMarker").RefersToRange
If lngRow = 0 Then
lngRow = rng1.Row
Exit Sub
End If
If rng1.Row = lngRow Then Exit Sub
If rng1.Row < lngRow Then
MsgBox lngRow - rng1.Row & " rows removed"
Else
MsgBox rng1.Row - lngRow & " rows added"
End If
lngRow = rng1.Row
End Sub
Try this code:
Private Sub Worksheet_Change(ByVal Target As Range)
Dim lNewRowCount As Long
ActiveSheet.UsedRange
lNewRowCount = ActiveSheet.UsedRange.Rows.Count
If lOldRowCount = lNewRowCount Then
ElseIf lOldRowCount > lNewRowCount Then
MsgBox ("Row Deleted")
lOldRowCount = lNewRowCount
ElseIf lOldRowCount < lNewRowCount Then
MsgBox ("Row Inserted")
lOldRowCount = lNewRowCount
End If
End Sub
Also add this in the ThisWorkBook module:
Private Sub Workbook_Open()
ActiveSheet.UsedRange
lOldRowCount = ActiveSheet.UsedRange.Rows.Count
End Sub
And then this in its own module:
Public lOldRowCount As Long
The code assumes you have data in row 1. Note the very first time you run it you make get a false result, this is because the code needs to set the lRowCount to the correct variable. Once done it should be okay from then on in.
If you don't want to use the Public variable and worksheet open event then you could use a named range on your worksheet somewhere and store the row count (lRowCount) there.
After searching for a bit decided to solve it myself.
In your Worksheet module (e.g. Sheet1 under Microsoft Excel Objects in VBA Editor) insert the following:
Private usedRowsCount As Long 'use private to limit access to var outside of sheet
'Because select occurs before change we can record the current usable row count
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
usedRowsCount = Target.Worksheet.UsedRange.rows.count 'record current row count for row event detection
End Sub
'once row count recorded at selection we can compare the used row count after change occurs
'with the Target.Address we can also detect which row has been added or removed if you need to do further mods on that row
Private Sub Worksheet_Change(ByVal Target As Range)
If usedRowsCount < Target.Worksheet.UsedRange.rows.count Then
Debug.Print "Row Added: ", Target.Address
ElseIf usedRowsCount > Target.Worksheet.UsedRange.rows.count Then
Debug.Print "Row deleted: ", Target.Address
End If
End Sub
Assumption: That "distinguish the two" means to distinguish adding/deleting a row from any other type of change. If you meant, how to tell if the change was an add row OR delete row, then ignore my answer below.
In the case of inserting or deleting a row, the target.cells.count will be all the cells in the row. So you can use this If statement to capture it. Notice I use cells.columns.count since it might be different for each file. It will also trigger if the user selects an entire row and hits "delete" (to erase the values) so you'll need to code a workaround for that, though...
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target.Cells.Count = Cells.Columns.Count Then
MsgBox "Row added or deleted"
End If
End Sub
Some of what your end purpose of distinguishing between insertions and deletions ends up as will determine how you want to proceed once an insertion or deletion has been identified. The following can probably be cut down substantially but I have tried to cover every possible scenario.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo bm_Safe_Exit
Application.EnableEvents = False
Application.ScreenUpdating = False
Dim olr As Long, nlr As Long, olc As Long, nlc As Long
With Target.Parent.Cells
nlc = .Find(what:=Chr(42), after:=.Cells(1), LookIn:=xlValues, lookat:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
nlr = .Find(what:=Chr(42), after:=.Cells(1), LookIn:=xlValues, lookat:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Application.Undo 'undo the last change event
olc = .Find(what:=Chr(42), after:=.Cells(1), LookIn:=xlValues, lookat:=xlPart, _
SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
olr = .Find(what:=Chr(42), after:=.Cells(1), LookIn:=xlValues, lookat:=xlPart, _
SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Application.Repeat 'redo the last change event
End With
If nlr <> olr Or nlc <> olc Then
Select Case nlr
Case olr - 1
Debug.Print "One (1) row has been deleted"
Case Is < (olr - 1)
Debug.Print (olr - nlr) & " rows have been deleted"
Case olr + 1
Debug.Print "One (1) row has been inserted"
Case Is > (olr + 1)
Debug.Print (nlr - olr) & " rows have been inserted"
Case olr
Debug.Print "No rows have been deleted or inserted"
Case Else
'don't know what else could happen
End Select
Select Case nlc
Case olc - 1
Debug.Print "One (1) column has been deleted"
Case Is < (olc - 1)
Debug.Print (olc - nlc) & " columns have been deleted"
Case olc + 1
Debug.Print "One (1) column has been inserted"
Case Is > (olc + 1)
Debug.Print (nlc - olc) & " columns have been inserted"
Case olc
Debug.Print "No columns have been deleted or inserted"
Case Else
'don't know what else could happen
End Select
Else
'deal with standard Intersect(Target, Range) events here
End If
bm_Safe_Exit:
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Essentially, this code identifies the last cell column-wise and the last cell cell row-wise. It then undoes the last operation and checks again. Comparing the two results allows it to determine whether a row/column has been inserted/deleted. Once the four measurements have been taken, it redoes the last operation so that any other more standard Worksheet_Change operations can be processed.
There are two a bit another approaches both based on the following template.
Define a module or class module variable of Range type.
“Pin” a special range by assigning it to the variable using absolute address and save its address or size (it depends on approach).
To determine a subtype of user action manipulate with the variable in a sheet change event handler.
In the first approach the whole range of interest is assigned to the variable and range's size is saved. Then in a sheet change event handler the following cases must be processed:
an exception occurs when accessing Address property => the pinned range is no longer exist;
the address of changed cell is below then pinned range => an insertion was => update the variable
a new size of the pinned range is different from saved (smaller => something was deleted, bigger => something was inserted).
In the second approach a “marker” range is assigned to the variable (see example below) and the range address is saved in order to determine movements or shifts in any direction. Then in a sheet change event handler the following cases must be processed::
an exception occurs when accessing Address property => the pinned “marker” range is no longer exist;
the address of changed cell is below then "marker" range => an insertion was => update the variable
there is a difference in any direction, i.e. abs(new_row - saved_row) > 0 or abs(new_col-saved_col) > 0 => the pinned range was moved or shifted.
Pros:
User-defined name is not used
UsedRange property is not used
A pinned range is updated accordingly to user actions instead of assumption that a user action will not occur below 1000-th row.
Cons:
The variable must be assigned in a workbook open event handler in order to use it in a sheet change event handler.
The variable and a WithEvents-variable of object must be assigned to Nothing in a workbook close event handler in order to unsubscribe form the event.
It is impossible to determine sort operations due to they change value of range instead of exchange rows.
The following example shows that both approaches could work. Define in a module:
Private m_st As Range
Sub set_m_st()
Set m_st = [$A$10:$F$10]
End Sub
Sub get_m_st()
MsgBox m_st.Address
End Sub
Then run set_m_st (simply place a cursor in the sub and call Run action) to pin range $A$10:$F$10. Insert or delete a row or cell above it (don't confuse with changing cell(s) value). Run get_m_st to see a changed address of the pinned range. Delete the pinned range to get "Object required" exception in get_m_st.
Capture row additions and deletions in the worksheet_change event.
I create a named range called "CurRowCnt"; formula: =ROWS(Table1).
Access in VBA code with:
CurRowCnt = Evaluate(Application.Names("CurRowCnt").RefersTo)
This named range will always hold the number of rows 'after' a row(s) insertion or deletion. I find it gives a more stable CurRowCnt than using a global or module level variable, better for programming, testing and debugging.
I save the CurRowCnt to a custom document property, again for stability purposes.
ThisWorkbook.CustomDocumentProperties("RowCnt").Value = Evaluate(Application.Names("CurRowCnt").RefersTo)
My Worksheet_Change Event structure is as follows:
Dim CurRowCnt as Double
CurRowCnt = Evaluate(Application.Names("CurRowCnt").RefersTo)
Select Case CurRowCnt
'' ########## ROW(S) ADDED
Case Is > ThisWorkbook.CustomDocumentProperties("RowCnt").Value
Dim r As Range
Dim NewRow as Range
ThisWorkbook.CustomDocumentProperties("RowCnt").Value = _
Evaluate(Application.Names("CurRowCnt").RefersTo)
For Each r In Selection.Rows.EntireRow
Set NewRow = Intersect(Application.Range("Table1"), r)
'Process new row(s) here
next r
'' ########## ROW(S) DELETED
Case Is < ThisWorkbook.CustomDocumentProperties("RowCnt").Value
ThisWorkbook.CustomDocumentProperties("RowCnt").Value = _
Evaluate(Application.Names("CurRowCnt").RefersTo)
'Process here
'' ########## CELL CHANGE
'Case Is = RowCnt
'Process here
'' ########## PROCESSING ERROR
Case Else 'Should happen only on error with CurRowCnt or RowCnt
'Error msg here
End Select