0

I am wondering if it is possible to call a private Sub worksheet_Change(ByVal Target As Range) type of sub from another public sub? I know that you can't really 'call' the sub but Run it, however my attempts at running the sub doesn't seem to work. This is what I have tried:

Sub AccessTransfer()
Range("A1:F1").Select
Selection.Copy
Sheets("Sheet2").Select
ActiveSheet.Paste
ActiveCell.Offset(0, 6).Value = "Oven"
Range("A65536").End(xlUp).Offset(1, 0).Select
Run.Application "Private Sub Worksheet_Change(ByVal Target As Range)"

Sheets("Sheet1").Select

Application.CutCopyMode = False

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Application.CountIf(Range("A:A"), Target) > 1 Then
    MsgBox "Duplicate Entry", vbCritical, "Remove Data"
    Target.Value = ""
End If
Range("A65536").End(xlUp).Offset(1, 0).Select
End Sub

Any help or suggestions on how to fix my problem would be most appreciated.

Charlie West
  • 61
  • 2
  • 12
  • I believe you can just place the current code under `Worksheet_Change` into a module and then call that from both. – tjb1 Jul 26 '16 at 17:25
  • Just write any value on the worksheet as itself. e.g. `sheet1.cells(1, 1) = sheet1.cells(1, 1).value` –  Jul 26 '16 at 17:25
  • Why would you want to do that? There might be a better way to get what you want done, and avoid possible [XY problems](https://meta.stackexchange.com/questions/66377/what-is-the-xy-problem). Also, it's ***highly*** suggested to [avoid using `.Select`/`.Activate`](https://stackoverflow.com/questions/10714251/how-to-avoid-using-select-in-excel-vba-macros). @Jeeped - isn't the default `.Value`? Why either leave it out of the left side, or add it to the right? For confirmation for the user? – BruceWayne Jul 26 '16 at 17:26
  • 1
    @BruceWayne - Yes, the default is the [Range.Value property](https://msdn.microsoft.com/en-us/library/office/ff195193.aspx). That's just the way I write it. –  Jul 26 '16 at 17:28
  • There are a bunch of things wrong with your code. For starters, you may be making a change (e.g. `Target.Value = ""`) in the Worksheet_Change which will trigger another event. For a couple more, you haven't isolated Target to column A and have not dealt with more than a single cell being Target. –  Jul 26 '16 at 17:31
  • I am very new to vba and this bit of code is just a small piece of a much larger piece of code that takes records entered from sheet1 and puts into sheet 2 to create a table, I'm trying to get column A to be unique so I need to have some type of warning prompt when a duplicate value is entered. Please if you can explain in a way that I can better understand it would be very appreciated. – Charlie West Jul 26 '16 at 17:42
  • Have you considered [Range.RemoveDuplicates method](https://msdn.microsoft.com/en-us/library/office/ff193823.aspx)? –  Jul 26 '16 at 18:04
  • In order to *call* the event handler, you'd need to do: `Application.Run "Sheet2.Worksheet_Change", Sheet2.Range("A1")` (modify the Sheet's codename & `Range` argument as needed) – David Zemens Jul 26 '16 at 18:15

2 Answers2

2
With Sheets("Sheet2").Range("A65536").End(xlUp).Offset(1, 0)
    .Value = .Value
End With

will trigger the Event, but the Paste should already have done that...

EDIT: As commenters have pointed out, there are other issues with your code: this should be something like what you want to do - 

Sub AccessTransfer()

    Dim shtSrc As Worksheet, shtDest As Worksheet
    Dim v, c As Range

    Set shtSrc = ActiveSheet
    Set shtDest = ThisWorkbook.Sheets("Sheet2")

    v = shtSrc.Range("A1").Value  'value to check...

    If Application.CountIf(shtDest.Range("A:A"), v) > 0 Then
        MsgBox "Value '" & v & "' already exists!", vbCritical, "Can't Transfer!"
    Else
       'OK to copy over...
       Set c = shtDest.Range("A65536").End(xlUp).Offset(1, 0)
       shtSrc.Range("A1:F1").Copy c
       c.Offset(0, 6).Value = "oven"
    End If

    Application.CutCopyMode = False

End Sub
Tim Williams
  • 154,628
  • 8
  • 97
  • 125
  • I don't know what I am supposed to do with your code or how it helps, could you please give some more information? – Charlie West Jul 26 '16 at 17:58
  • Doh! Never even thought to halt hte Copy/Paste operation of it already existed! –  Jul 26 '16 at 18:01
  • @CharlieWest - you can replace your existing `AccessTransfer` with the code above: then you will not need the `Worksheet_Change` event handler. – Tim Williams Jul 26 '16 at 19:08
0

There are a couple of things wrong with your code.

  • You may be making a change (e.g. Target.Value = "") in the Worksheet_Change which will trigger another event.
  • You haven't isolated Target to column A and have not dealt with more than a single cell being Target.

Module1 code sheet:

Sub AccessTransfer()
    With Worksheets("Sheet2")
        Worksheets("Sheet1").Range("A1:F1").Copy _
            Destination:=.Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0)
        'Sheet2's Worksheet_Change has been triggered right here

        'check if the action has been reversed
        If Not IsEmpty(.Cells(.Rows.Count, "A").End(xlUp)) Then
            'turn off events for the Oven value write
            Application.EnableEvents = False
            .Cells(.Rows.Count, "A").End(xlUp).Offset(0, 6) = "Oven"
            'turn events back on
            Application.EnableEvents = True
        End If
    End With
End Sub

Sheet2 code sheet:

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    If Not Intersect(Target, Range("A:A")) Is Nothing Then
        On Error GoTo bm_Safe_Exit
        Application.EnableEvents = False
        Dim c As Long, rngs As Range
        Set rngs = Intersect(Target, Range("A:A"))
        For c = rngs.Count To 1 Step -1
            If Application.CountIf(Columns("A"), rngs(c)) > 1 Then
                MsgBox "Duplicate Entry in " & rngs(c).Address(0, 0), _
                    vbCritical, "Remove Data"
                rngs(c).EntireRow.Delete
            End If
        Next c
    End If
bm_Safe_Exit:
    Application.EnableEvents = True
End Sub
Graham
  • 7,431
  • 18
  • 59
  • 84