(Solved) – Excel VBA – Prompt user to overwrite data before copying

  • by
(solved)-–-excel-vba-–-prompt-user-to-overwrite-data-before-copying

I am writing a code which copies customer data from one worksheet “Raw Data” to another one “Customer Data-Base”. When the data is copied, the code should check if the data already exists in the “Customer Data-Base” worksheet and should then prompt the user if they want to overwrite the existing data. If the user selects yes, the data should be updated for that particular customer ID only. I have written some code, but have not had much luck with it. Can someone please help?

Sub Copy_Dbase_Code_msgbox()


    Dim wsCopy As Worksheet
    Dim wsDest As Worksheet
    Dim lDestLastRow As Long
    Dim Samlastrow As Long
    Dim Msgconfirm As VBA.VbMsgBoxResult

    Dim r As Long
    Dim c As Long

    Let r = Rows.Count

    Dim sampleno As Variant


    Application.ScreenUpdating = False

    'open book in background

    Workbooks.Open Filename:="C:UsersMuhammad AliDesktopCustomer Data-Base.xlsx"

    Set wsCopy = Workbooks("Raw data").Worksheets("customers")

    Set wsDest = Workbooks("Customer Data-base.xlsx").Worksheets("Data")

    Samlastrow = wsDest.Cells(wsDest.Rows.Count, "A").End(xlUp).Offset(1).Row
    lDestLastRow = wsDest.Cells(wsDest.Rows.Count, "B").End(xlUp).Offset(1).Row

    'check for existing data
    Let c = wsCopy.Cells(10, 1).Value

    For r = 1 To lDestLastRow

        If r = c Then

            Msgconfirm = MsgBox("This data already exists, Are you sure that you want to overwrite." _
                              & vbNewLine & "Would you like to continue?", vbOKCancel   vbDefaultButton2, "Confirmation Required")
            If Msgconfirm = vbCancel Then Exit Sub

        Else


            wsCopy.Range("A2").Copy
            wsDest.Range("A" & lDestLastRow).PasteSpecial xlPasteValues, Transpose:=True
            wsCopy.Range("B3:B18").Copy
            wsDest.Range("B" & lDestLastRow).PasteSpecial xlPasteValues, Transpose:=True


            wsCopy.Range("A21").Copy
            wsDest.Range("A" & lDestLastRow   1).PasteSpecial xlPasteValues, Transpose:=True
            wsCopy.Range("B22:B37").Copy
            wsDest.Range("B" & lDestLastRow   1).PasteSpecial xlPasteValues, Transpose:=True


            wsCopy.Range("A39").Copy
            wsDest.Range("A" & lDestLastRow   2).PasteSpecial xlPasteValues, Transpose:=True
            wsCopy.Range("B40:B55").Copy
            wsDest.Range("B" & lDestLastRow   2).PasteSpecial xlPasteValues, Transpose:=True


        End If

    Next r


    Application.ScreenUpdating = True

End Sub

Leave a Reply

Your email address will not be published. Required fields are marked *