Code Macro jika ada penambahan data pada baris berikutnya

  1. 5 bulan yang lalu

    Mohon bantuannya,ya para suhu

    Sub Test()
    'Jika Ada Penambahan data pada range(A3:A500) -> Mohon Bantuan Untuk Code Vba nya
    Then
    Call (Prosedur Macro Lainnya)
    End Sub


    Terimakasih sebelumnya:)

  2. manweljs_

    Mei 12 Terverifikasi + 5.184 Poin
    Di sunting 5 bulan yang lalu oleh manweljs_

    @goral

    edit - malu sama postingan di bawah (^_^)/

  3. Caton

    Mei 12 Terverifikasi Indonesia + 12.014 Poin

    @Goral...

    Coba manfaatkan Event Procedure Worksheet_Change pada modul Sheet Object yang diinginkan:

    Option Explicit
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, [A3:A500]) Is Nothing Then
            If Target <> vbNullString Then
                '+--- Contoh proses.
                MsgBox "Change on " & Target.Address
            End If
        End If
    End Sub

    Demikian.

  4. @Caton
    @manweljs_
    Terimakasih,sangat membantu sekali =D
    sudah saya coba..dan sukses
    dan,ternyata ada yang ktinggalan,codenya ada tambahan ini mas :)
    script apakah yang harus saya tambahkan?

    Jika Ada Penambahan data dan perubahan data

  5. Caton

    Mei 12 Terverifikasi Indonesia + 12.014 Poin
    Di sunting 5 bulan yang lalu oleh Caton

    @Goral...

    Contoh penyesuaian (modifikasi) dari script sebelumnya:

    Option Explicit
    
    Private m_xRangeValue() As Variant
    
    Private Sub Worksheet_Change(ByVal Target As Range)
        If Not Intersect(Target, [A3:A500]) Is Nothing Then
            If Target <> vbNullString Then
                If m_xRangeValue(Target.Row - 2, 1) <> vbNullString Then
                    '+--- Ada perubahan (edit) sel data.
                    MsgBox "Sel " & Target.Address & " sudah diedit!"
                Else
                    '+--- Ada penambahan data baru.
                    MsgBox "Penambahan data pada sel " & Target.Address
                End If
                m_xRangeValue(Target.Row - 2, 1) = Target.Value
            End If
        End If
    End Sub
    
    Private Sub Worksheet_SelectionChange(ByVal Target As Range)
        If Not Intersect(Target, [A3:A500]) Is Nothing Then
            On Error Resume Next
            If UBound(m_xRangeValue, 1) < 1 Or Err.Number Then
                m_xRangeValue = [A3:A500].Value
            End If
            Err.Clear: On Error GoTo 0
        End If
    End Sub

    Selain cara di atas, masih ada cara lainnya. Namun untuk saat ini, saya rasa itu saja yang contoh yang bisa mas terapkan. Mudah-mudahan sesuai.

    Demikian.

  6. terimakasih,.sangat sesuai yang diharapkan =D
    BTW,jadi pingin tau cara2 lainnya :)
    siapa tau bisa di share
    =D

 

atau Mendaftar untuk ikut berdiskusi!