Running Worksheet_Change on top of itself intentionally

2018-07-12 06:28 Jeeped imported from Stackoverflow

_{Skip my rambling narrative by scrolling down to tldr and Question.}

I have several rows and columns with values; e.g. A10:G15. In each row, the value of the cell immediately to the right of any cell is dependent on that cell up to the extents of the columns involved. In this manner, the value of a cell immediately to the right of any cell is always numerically larger than the cell or blank if the original cell is blank.

To maintain this dependency, I want to clear any values to the right if I clear the value from a cell within A:F or progressively add a random number to the remaining cells to the right if I input a new value into any cell within A:F.

Sample data. The 7 in the top-left is A10.

    A    B     C     D     E     F     G
    7    12    15    19    23    27    28
    4     6    10    14    17    18    22
    8    10    14    18    23    26    31
    8    13    15    18    22    25    30
    8    13    16    18    19    21    24
    0     3     4     9    10    12    16

'similar data in A19:G22 and A26:G30

tldr

  ▪ If I clear D12, E12:G12 should also be cleared.
  ▪ If I type a new value into C14 then D14:G14 should each receive a new value which is
      random but larger than the previous value.
  ▪ I might want to clear or paste in several values in a column and would expect the
      routine to deal with each in turn.
  ▪ I have several of these non-contiguous regions (see Union'ed range in code sample
      below) and would prefer a DRY coding style.

Code

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    'Debug.Print Target.Address(0, 0)
    If Not Intersect(Target, Range("A10:F15, A19:F22, A26:F30")) Is Nothing Then
        Dim t As Range
        For Each t In Intersect(Target, Range("A10:F15, A19:F22, A26:F30"))
            If IsEmpty(t) Then
                t.Offset(0, 1).ClearContents
            ElseIf Not IsNumeric(t) Then
                t.ClearContents
            Else
                If t.Column > 1 Then
                    If t <= t.Offset(0, -1) Or IsEmpty(t.Offset(0, -1)) Then
                        t.ClearContents
                    Else
                        t.Offset(0, 1) = t + Application.RandBetween(1, 5)
                    End If
                Else
                    t.Offset(0, 1) = t + Application.RandBetween(1, 5)
                End If
            End If
        Next t
    End If

End Sub

Code explanation

This event driven Worksheet_Change deals with each cell that has changed but only modifies the cell directly to the right, not the remaining cells in that row. The job of maintaining the remaining cells is achieved by leaving event triggers active so that when that single cell to the right is modified, the Worksheet_Change triggers an event that calls itself with a new Target.

Question

The above routine seems to run fine and I have yet to destabilize my project environment despite my best/worst efforts. So what's wrong with intentionally running a Worksheet_Change on top of itself if the reiteration cycles can be controlled to a finite result?

2 answers

answered 2018-07-12 09:09 Franz

I would argue that what is wrong with recursively triggering the change event is that this way Excel can only sustain a pretty tiny call stack. At 80 calls it killed my Excel instance. When I outsourced the recursion I at least got to a little over 1200 calls, of course adding redundancy to some extent:

Option Explicit
Const RANGE_STR As String = "A10:F15, A19:F22, A26:F30"

Private Sub Worksheet_Change(ByVal target As Range)
    Application.EnableEvents = False
        Dim t As Range
        If Not Intersect(target, Range(RANGE_STR)) Is Nothing Then
            For Each t In Intersect(target, Range(RANGE_STR))
                makeChange t
            Next t
        End If
    Application.EnableEvents = True
End Sub

Sub makeChange(ByVal t As Range)
    If Not Intersect(t, Range(RANGE_STR)) Is Nothing Then
        If IsEmpty(t) Then
            t.Offset(0, 1).ClearContents
            makeChange t.Offset(0, 1)
        ElseIf Not IsNumeric(t) Then
            t.ClearContents
            makeChange t
        Else
            If t.Column > 1 Then
                If t <= t.Offset(0, -1) Or IsEmpty(t.Offset(0, -1)) Then
                    t.ClearContents
                    makeChange t
                Else
                    t.Offset(0, 1) = t + Application.RandBetween(1, 5)
                    makeChange t.Offset(0, 1)
                End If
            Else
                t.Offset(0, 1) = t + Application.RandBetween(1, 5)
                makeChange t.Offset(0, 1)
            End If
        End If
    End If
End Sub

answered 2018-07-12 12:46 EvR

I don't think you need recursive calls, read by area, by row, into array, change array and write back to sheet:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim MyArr As Variant, TargetR As Long, TargetC As Long, i As Long, ar As Range, myRow As Range

For Each ar In Target.Areas
    TargetC = ar.Column
        For Each myRow In ar.Rows
            TargetR = myRow.Row
            MyArr = Range(Cells(TargetR, 1), Cells(TargetR, 7)) 
            If IsEmpty(MyArr(1, TargetC)) Or Not IsNumeric(MyArr(1, TargetC)) Then
                For i = TargetC To UBound(MyArr, 2)
                    MyArr(1, i) = Empty
                Next i
            Else
                For i = TargetC + 1 To UBound(MyArr, 2)
                    MyArr(1, i) = MyArr(1, i - 1) + Application.RandBetween(1, 5)
                Next i
            End If
            Application.EnableEvents = False
            If Not Intersect(Range(Cells(TargetR, 1), Cells(TargetR, 7)), Range("A10:F15, A19:F22, A26:F30")) Is Nothing Then
            Range(Cells(TargetR, 1), Cells(TargetR, 7)) = MyArr
            End If
            Application.EnableEvents = True
        Next myRow
Next ar

End Sub

See also questions close to this topic

Finding Next Occurrence of Range

I am building a code that will allow me to find the next occurrence of a range and build a specific concatenate formula off of attributes from each range. Each range will start with "FINANCIAL STATEMENT" and end with "TOTAL BALANCE," which has been defined in my code below. I have build this out, but am only able to run for the first occurrence. Once the first occurrence of the range is found, in column A I have built out a concatenate code that concatenates specific items in the range with the concatenate results in rows 3 and 5 of each range. I am looking for help in finding the next range that lays beneath the original range but has the same toprow and bottomrow criteria.

I'm 100% ok with the concatenate portion, I just need help with being able to find the next applicable range and running this same concatenate formula.

This is the code thus far:

Sub Concatenate()

Application.ScreenUpdating = False
Application.DisplayAlerts = False

Dim TopRow, BottomRow, DataSelect, FundSelect, FSRange, FSRangeCritiera, MiddleRow As Range
Dim cell As Range
Dim Master As Workbook
Dim dateformat As String
Dim last row As Integer
Dim fundname, funddate As Range

With ActiveSheet
Set TopRow = Range("A:B").Find(What:"FINANCIAL STATEMENT", LookIn:=x1Values)
Set MiddleRow = Range("A:B").Find(What:="Entity*", LookIn:=x1Values)
Set BottomRow = Range("A:B").Find(What:="TOTAL BALANCE", LookIn:=x1Values)

With ActiveSheet
Set FSRange = Range(TopRow, BottomRow).Columns(0)
Set FSRangeCriteria = Range(TopRow, MiddleRow).Columns(1)
Set DateSelect = FSRangeCriteria.Rows(3)
Set FundSelect = FSRangeCriteria.Rows(5)
Set funddate = FSRange.Rows(3)
funddate = Format(funddate, " MM DD YYYY")
Set fundname = FSRange.Rows(5)

FSRange.Activate
For each cell in FSRange.Cells
If cell.Offset(I,1).Text Like "As of*" Then
cell.Formula = Mid(DateSelect, 7)
dateformat = Format(funddate, " MM DD YYYY")
ElseIf cell.offset(I,1).Text Like "Entity*" Then
cell.Formula = Range(FundSelect, 4)
ElseIf IsEmpty(cell.offset(I, 1)) And IsEmpty(cell.offset(I,2)) Then cell.offset(I,0) = ""
Else: cell.Value = fund name & " - " & cell.offset(I,1) & cell.offset(I, 2) & " - " & dateformat

End If 
Next cell

End With
End Sub

Filter & Unfilter Entire Data Based on Active Cell Selection & Unselection In Excel

I have an Excel Sheet Contains 3 Columns Name,Mobile,Amount and Multiple rows with relevant data.

I want to Create a Excel VBA Code to do as under:

a) Filter Entire Data Based on Active Cell Selection from Mobile Column

b) Unfilter Entire Data once Cell from Mobile Column is UnSelected or any other cell (other than the cells in Mobile Column) is selected.

Note: By Selection i mean simple clicking on the cell and not double click

I tried to Find such code on the net and found below pasted code.But it does not serve the purpose.Can some one help please.

Option Explicit

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim rgTable As Range
    Dim rgData As Range
    Dim xColumn As Integer
    On Error Resume Next
    Application.ScreenUpdating = False
    Set rgTable = Range("mydata")
    With rgTable
        Set rgData = .Offset(1, 0).Resize(.Rows.Count - 1, .Columns.Count)
        If Not Application.Intersect(ActiveCell, rgData.Cells) Is Nothing Then
            xColumn = ActiveCell.Column - .Column + 1
            If ActiveSheet.AutoFilterMode = False Then
                .AutoFilter
            End If
            If ActiveSheet.AutoFilter.Filters(xColumn).On = True Then
                .AutoFilter Field:=xColumn
            Else
                .AutoFilter Field:=xColumn, Criteria1:=ActiveCell.Value
            End If
        End If
    End With
    Set rgData = Nothing
    Set rgTable = Nothing
    Application.ScreenUpdating = True

End Sub

Please note that above code does not solve the purpose but i have pasted the same for reference purpose only.Thus New Simple Code will be preferred & requested.

passing variables as arguments from excel VBA
I use the following code for passing arguments to my script from VBA.

Successful case: (argument value without space)
```
FilePath = "c:\Users\dimension_export.exe"
AppName = "Area_Sales"
Call Shell(FilePath & " " & AppName, 1)
```
Error case: (argument value with space (''))
```
FilePath = "c:\Users\dimension_export.exe"
AppName = "Total Sales"
Call Shell(FilePath & " " & AppName, 1)
```
when I do this, only the Total part in the AppName variable is passed as a argument to my exe file.

Is there any specific keyword or symbols I should pad up?

Related questions

Running Worksheet_Change on top of itself intentionally

2 answers

See also questions close to this topic