MMMM
MMMM

Reputation: 29

Execute Procedure when Value in a Cell/Range Changes

I'm new to VBA and wrote the following codes according to my data set. The goal here is to execute my procedure if a cell/range gets changed by pasting new data into the worksheet, most probably the sheet will be empty as it will follow by a clear content procedure. However, the code is not triggering the change event, I've tried several codes from Google, but none of them worked. Please note that my procedure gets me exactly the data I want in the format I want, however, if changes are needed, kindly let me know.

PLEASE HELP

1. Change event trigger - stored under Sheet1

Private Sub Worksheet_Change(ByVal Target As Range)


If Not Intersect(Target, Me.Range("A1")) Is Nothing Then
        Application.EnableEvents = False
        Call LoopandIfStatement
        Application.EnableEvents = True

End If

End Sub

2. My procedure - stored under Sheet1 below the event above

Sub LoopandIfStatement()


Dim SHT As Worksheet

Set SHT = ThisWorkbook.Worksheets("CB")

MyLr = SHT.Cells(Rows.Count, 1).End(xlUp).Row

Dim I As Long
For I = 1 To MyLr

Dim O As Long

Dim U As Range
Set U = SHT.Range("A" & I)

    If IsEmpty(SHT.Range("a" & I).Value) = False Then

        SHT.Range("k" & I).Value = SHT.Range("A" & I).Value

    Else

On Error GoTo ABC

        SHT.Range("k" & I).Value = U.Offset(-1, 0)

    End If

Next I

For O = 2 To MyLr

    If SHT.Range("g" & O).Value = "Closing Balance" Then

    SHT.Range("l" & O).Value = SHT.Range("j" & O).Value

      End If

  Next O

 ABC:

End Sub

Results

Upvotes: 0

Views: 547

Answers (1)

Ricardo Diaz
Ricardo Diaz

Reputation: 5696

This will trigger whenever new data is pasted in any cell of columns A to J

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Me.Range("A:J")) Is Nothing Then

        Application.EnableEvents = False

        Call LoopandIfStatement

        Application.EnableEvents = True

    End If

End Sub

Regarding your sub LoopandIfStatement here are some suggestions:

  1. Use Option explicit at the top of your modules (see this)
  2. Declare all your variables (you're missing: Dim MyLr as long)
  3. Try to name your variables to something understandable (e.g. instead of MyLr you could have lastRow)
  4. If you need to exit a Sub you can use Exit Sub instead of a Goto ABC

EDIT:

Added code for the loop and the change worksheet event.

Paste it behind the CB Sheet module

Some highlights:

  1. When you triggered the loop on each worksheet change, it would re-apply all the steps to all the cells. You can work with changed ranges using the Target argument/variable in the Worksheet_Change event
  2. To loop through an existing range see the AddAccountBalanceToRange procedure
  3. Try to think and plan your code in steps or actions that can be grouped
  4. Use comments to describe the purpose of what you're doing
  5. Remember to delete obsolete code (saw you had a copy of the procedure in a module)

Option Explicit

Private Sub CommandButton1_Click()
    ThisWorkbook.Worksheets("Data").Columns("A:J").Copy
    ThisWorkbook.Worksheets("CB").Range("A:J").PasteSpecial Paste:=xlPasteValues
End Sub

Private Sub CommandButton2_Click()
    ThisWorkbook.Worksheets("CB").Range("A:L").ClearContents
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim targetUsedRange As Range

    ' Do something on non empty cells
    Set targetUsedRange = Intersect(Target, Target.Parent.UsedRange)

    If Not Intersect(Target, Me.Range("A:J")) Is Nothing Then

        Application.EnableEvents = False

        Call AddAccountBalance(targetUsedRange)

        Application.EnableEvents = True

    End If

End Sub

Private Sub AddAccountBalance(ByVal Target As Range)

    Dim targetSheet As Worksheet
    Dim evalRow As Range

    Dim lastColumn As Long

    Dim accountNumber As String
    Dim balanceString As String
    Dim narrative As String
    Dim balanceValue As Long

    balanceString = "Closing Balance"

    ' If deleting or clearing columns
    If Target Is Nothing Then Exit Sub

    ' Do something if there are any values in range
    If Application.WorksheetFunction.CountA(Target) = 0 Then Exit Sub

    ' Get the parent sheet of the cells that were modifid
    Set targetSheet = Target.Parent

    ' Get the last empty cell column in row 1 -Cells(3 -> this is row 3)- In the sample book: column K
    lastColumn = targetSheet.Cells(3, targetSheet.Columns.Count).End(xlToLeft).Column

    ' Loop through each of the rows that were modified in range
    For Each evalRow In Target.Cells.Rows


        ' Do something if account number or narrative are not null
        If targetSheet.Cells(evalRow.Row, 1).Value <> vbNullString Or targetSheet.Cells(evalRow.Row, 7).Value <> vbNullString Then

            ' Store columns values in evaluated row
            accountNumber = targetSheet.Cells(evalRow.Row, 1).Value
            narrative = targetSheet.Cells(evalRow.Row, 7).Value
            If IsNumeric(targetSheet.Cells(evalRow.Row, 10).Value) Then balanceValue = targetSheet.Cells(evalRow.Row, 10).Value

            ' Add account number
            If accountNumber <> vbNullString Then
                targetSheet.Cells(evalRow.Row, lastColumn).Value = accountNumber
            End If

            ' Add closing balance
            If narrative = balanceString Then
                targetSheet.Cells(evalRow.Row, lastColumn).Value = targetSheet.Cells(evalRow.Row, 1).Offset(-1, 0).Value
                targetSheet.Cells(evalRow.Row, lastColumn).Offset(0, 1).Value = balanceValue
            End If

            ' Format last two columns (see how the resize property takes a single cell and expands the range)
            With targetSheet.Cells(evalRow.Row, lastColumn).Resize(, 2).Interior
                .ThemeColor = xlThemeColorAccent6
                .TintAndShade = 0.799981688894314
                .PatternTintAndShade = 0
            End With

            ' Auto fit last column (K) (you could use the resize property as in the previous statement)
            targetSheet.Columns(lastColumn).EntireColumn.AutoFit
        End If

    Next evalRow

End Sub

Public Sub AddAccountBalanceToRange()

    Dim targetSheet As Worksheet
    Dim evalRange As Range


    Set targetSheet = ThisWorkbook.Worksheets("CB")
    Set evalRange = targetSheet.Range("A1:A42")

    AddAccountBalance evalRange

End Sub

Upvotes: 1

Related Questions