VBA Code not auto dating as intended anymore

PuntingJawa

Board Regular
Joined
Feb 25, 2021
Messages
162
Office Version
  1. 365
  2. 2019
Platform
  1. Windows
Good afternoon. I am having issues with some VBA that I got here a long while ago. It was working flawlessly but recently I have noticed that it is no longer dating correctly when the log is generated. Other than where it pulls and pastes to there have been no other changes.
The way this works is I have the VBA locked to a button and when I generate numbers based on criteria I press the button and it will copy from designated lines on multiple sheets, check for duplicates, and paste in another sheet, workbook, or both and date in the line next to it when this happened. Recently, it stopped logging the dates like before and is now overwriting for the date I last pressed the log button.
Original post below this.
Copying Sheet from one Workbook to another.

VBA Code:
Private Sub CommandButton1_Click()
    Call Worksheet_Activate_V3
End Sub

Private Sub Worksheet_Activate_V3()
'
'   This script attempts to copy data from a source file and paste it into a different sheet either into the same workbook and/or a different workbook.
'       After the choice is made, it will copy data to either or both or neither.
'       Dialog sheet coding inspired by a Rick Rothstein post. Thank you Rick!
'
'   \/ \/ \/ First line of execution \/ \/ \/
    Dim DialogSheetName                 As String                           ' <-- Start code execution at the beginning of this line
    Dim DestinationWorkbookName         As String
    Dim DestinationWorkbookSheetName    As String
'
    Dim DestinationWorkbook             As Workbook
'
'
    Set SourceWorkbookSheetToCopyTo = ThisWorkbook.Worksheets("LOG")                ' <-- LOG refers to the Destination sheet in the source workbook
'
    DestinationWorkbookName = "AUX-Log.xlsx"                                         ' <-- Set the correct name to your Log workbook that is in the same folder
    DestinationWorkbookSheetName = "Sheet1"                                         ' <-- Set this to the SN Log sheet name
'
    LogToSourceWorkbook = False                                     ' Log To Source Workbook = False
    LogToDestinationWorkbook = False                                ' Log To Destination Workbook = False
    DialogSheetName = "CustomButtons"
'
    Application.ScreenUpdating = False                              ' Turn Screen Updating off
    Application.DisplayAlerts = False                               ' Turn Display Alerts off
'
    On Error Resume Next                                            ' Turn on error handling ... ie. Resume Next
    ActiveWorkbook.DialogSheets(DialogSheetName).Delete             ' Delete previous dialog sheet, if by chance it exists.
    Err.Clear                                                       ' Clear any triggered error code
'
    Application.DisplayAlerts = True                                ' Turn Display Alerts back on
'
    Set LoggingDialogSheet = ActiveWorkbook.DialogSheets.Add        ' Add the custom dialog sheet. Creates Dialog* worksheet
'
'
    With LoggingDialogSheet                                         ' With the created dialog sheet ...
        .BringToFront
        .Name = DialogSheetName                                     '   Rename the created dialog sheet
        .Visible = xlSheetHidden                                    '   Hide the Created/Renamed dialog sheet
'
        With .DialogFrame                                           '   With the dialog box on the created dialog sheet
            .Height = 135                                           '       Set the height of the dialog box
            .Width = 433                                            '       Set the width of the dialog box
            .Caption = "Logging options."                           '       Set the title bar caption of the dialog box to the caption
        End With
'
        .Buttons("Button 2").Visible = False                        '   Hide default 'Button 2' ie. 'OK' button
        .Buttons("Button 3").Visible = False                        '   Hide default 'Button 3' ie. 'Cancel' button
'
        .Labels.Add 230, 45, 235, 18                                '   Add a label (Interior message line) at the top of the dialog box. Distance from Left, Top, Width, Height.
        .Labels(1).Caption = "What's your logging preference?"      '   Rename the new label/message to the caption
'
        .Buttons.Add 85, 80, 220, 18                                '   Add 1st custom button Distance from Left, Top, Width, Height. Creates 'Button *'
        With .Buttons(3)                                            '   With Buttons(3) ...
            .Caption = "Log To Source Workbook Only"                '       Rename the created button to the caption
            .OnAction = "ClickedCustomButtonAction"                 '       Set the on action Sub routine to run when this button is clicked
        End With
'
        .Buttons.Add 330, 80, 150, 18                               '   Add a 2nd custom button Distance from Left, Top, Width, Height. Creates 'Button *'
        With .Buttons(4)                                            '   With Buttons(4) ...
            .Caption = "Log To Destination Workbook Only"           '       Rename the created button to the caption
            .OnAction = "ClickedCustomButtonAction"                 '       Set the on action Sub routine to run when this button is clicked
        End With
'
        .Buttons.Add 85, 115, 220, 18                                       '   Add a 3rd custom button Distance from Left, Top, Width, Height. Creates 'Button *'
        With .Buttons(5)                                                    '   With Buttons(5) ...
            .Caption = "Log to Source Workbook and Destination Workbook"    '       Rename the created button to the caption
            .OnAction = "ClickedCustomButtonAction"                         '       Set the on action Sub routine to run when this button is clicked
        End With
'
        .Buttons.Add 330, 115, 150, 18                                  '   Add a 4th custom button Distance from Left, Top, Width, Height. Creates 'Button *'
        With .Buttons(6)                                                '   With Buttons(6) ...
            .Caption = "Never Mind, Don't Log Anything"                 '       Rename the created button to the caption
            .OnAction = "ClickedCustomButtonAction"                     '       Set the on action Sub routine to run when this button is clicked
        End With
'
'       Display the dialog box to the user and await selection from the user
        Application.ScreenUpdating = True                           '   Turn Screen Updating back on, Thus displaying the completed Dialog box for the user
'
        If .Show = False Then                                       '   If the X Cancel button was clicked on the title bar then ...
            MsgBox "No problem -- nothing will be logged.", 64, "Logging cancelled."    '       64 is the icon to show, ie. the 'i' icon ;
'
            Call DeleteOurDialogSheet                                                   '       Go and Delete the dialog sheet that was created.
            Exit Sub
        End If
    End With
'
    Call DeleteOurDialogSheet                                       '   Go and Delete the dialog sheet that was created.
'
'--------------------------------------------------------------------------------------------------------------------------------------------------------
'
    Application.Calculation = xlCalculationManual                                       ' Turn Auto Calculation Mode off
    Application.ScreenUpdating = False                                                  ' Turn Screen Updating off
'
    If LogToDestinationWorkbook = True Then                                                             ' Open other workbook if we plan to log to it
        Set DestinationWorkbook = Workbooks.Open(ThisWorkbook.Path & "\" & DestinationWorkbookName)     '   Open the other workbook
        Set DestinationWorkbookSheetToCopyTo = DestinationWorkbook.Worksheets(DestinationWorkbookSheetName) '   Set the sheet name to copy to in the destination workbook
    End If
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("CKSIN"): ColumnToCopyFrom = "F": ColumnToCopyTo = "A": DateColumn = "B"  '-- CKSIN Sheet2
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("CKSEX"): ColumnToCopyFrom = "F": ColumnToCopyTo = "c": DateColumn = "d"  '-- CKSEX Sheet3
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("MDCL"): ColumnToCopyFrom = "F": ColumnToCopyTo = "e": DateColumn = "f"  '-- MDCL Sheet4
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("MDCR"): ColumnToCopyFrom = "F": ColumnToCopyTo = "g": DateColumn = "h"  '-- MDCR Sheet5
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("SLRU"): ColumnToCopyFrom = "F": ColumnToCopyTo = "i": DateColumn = "j"  '-- SLRU Sheet6
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("EDO"): ColumnToCopyFrom = "F": ColumnToCopyTo = "k": DateColumn = "l"  '-- EDO Sheet7
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("GLEX"): ColumnToCopyFrom = "F": ColumnToCopyTo = "m": DateColumn = "n"  '-- GLEX Sheet8
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("MKS"): ColumnToCopyFrom = "F": ColumnToCopyTo = "o": DateColumn = "p"  '-- CKSIN Sheet9
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("MLSLH"): ColumnToCopyFrom = "F": ColumnToCopyTo = "q": DateColumn = "r"  '-- MLSLH Sheet10
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("MLSRH"): ColumnToCopyFrom = "F": ColumnToCopyTo = "s": DateColumn = "t"  '-- MLSRH Sheet11
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("CLID"): ColumnToCopyFrom = "F": ColumnToCopyTo = "u": DateColumn = "v"  '-- CLID Sheet12
    Call CopyPasteEtc
'
'
    Set SourceWorkbookSheetToCopyFrom = ThisWorkbook.Worksheets("GLIN"): ColumnToCopyFrom = "F": ColumnToCopyTo = "w": DateColumn = "x"  '-- GLIN Sheet13
    Call CopyPasteEtc
'
'

    If LogToDestinationWorkbook = True Then
        Worksheets("Sheet1").Range("A1").Select                                         '   Deselect the last range copied to
        DestinationWorkbook.Close savechanges:=True                                     '   Save/Close the 'SN Log.xlsx' workbook
    End If
'
    Application.ScreenUpdating = True                                                   ' Turn ScreenUpdating back on
    Application.Calculation = xlCalculationAutomatic                                    ' Turn Auto Calculaion back on
'
    MsgBox "Click the 'OK' button and then check the 'LOG' results."                    ' Let user know script has completed
End Sub


Private Sub DeleteOurDialogSheet()
'
    With Application                                                ' With the Application ...
        .ScreenUpdating = False                                     '   Turn Screen Updating off
        .DisplayAlerts = False                                      '   Turn Display Alerts off
'
        On Error Resume Next                                        '   Turn on error handling ... Resume Next
        DialogSheets("CustomButtons").Delete                        '   Delete 'CustomButtons' dialog sheet, if it exists
        Err.Clear                                                   '   Clear any triggered error code
'
        .DisplayAlerts = True                                       '   Turn Display Alerts back on
        .ScreenUpdating = True                                      '   Turn Screen Updating back on
    End With
End Sub

Sub CopyPasteEtc()
'
    If LogToSourceWorkbook = True Then
        SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & "2", SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & Rows.Count).End(xlUp)).Copy  ' Copy Column Data to Clipboard
'
        With SourceWorkbookSheetToCopyTo                                                ' Paste results to source workbook
            .Range(ColumnToCopyTo & "1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues   ' Paste Data from Source Column to End of Destination Column
            .Range(ColumnToCopyTo & "2", SourceWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp)).RemoveDuplicates 1    ' Remove Duplicates from Destination Column
            .Range(DateColumn & "2:" & DateColumn & SourceWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp).Row).Value = Date   ' Add Today's Date to next column
        End With
    End If
'
'------------------------------
'
    If LogToDestinationWorkbook = True Then
        SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & "2", SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & Rows.Count).End(xlUp)).Copy  ' Copy Column Data to Clipboard
'
        With DestinationWorkbookSheetToCopyTo                                           ' Paste results to destination workbook
            .Range(ColumnToCopyTo & "1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues   ' Paste Data from Source Column to End of Destination Column
            .Range(ColumnToCopyTo & "2", DestinationWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp)).RemoveDuplicates 1    ' Remove Duplicates from Destination Column
            .Range(DateColumn & "2:" & DateColumn & DestinationWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp).Row).Value = Date   ' Add Today's Date to next column
        End With
    End If
End Sub
 

Excel Facts

Square and cube roots
The =SQRT(25) is a square root. For a cube root, use =125^(1/3). For a fourth root, use =625^(1/4).
Sorry, I seem to have forgotten to add information. The following is the format in which the above pulls from. I was thinking of changing the whole setup for generation from the following using a userform in VBA. I just haven't learned enough to do this effectively yet. Since most information is static for this generation the userform should be simple enough to use. I'm just not there yet in terms of knowledge.

6-28-2021 AUX Label Database.xlsm
ABCDEFGH
1YearNo.S/NDescriptionPart NoDataMatrix FullData Matrix LHData Matrix RH
221001EDO21X001END DOOR OPERATOR (EDO)FUJ SY490062FUJ SY490062 EDO21X001FUJ SY490062 EDO21X001FUJ SY490062 EDO21X002
3Month002EDO21X002END DOOR OPERATOR (EDO)FUJ SY490062FUJ SY490062 EDO21X002FUJ SY490062 EDO21X003FUJ SY490062 EDO21X004
410003EDO21X003END DOOR OPERATOR (EDO)FUJ SY490062FUJ SY490062 EDO21X003FUJ SY490062 EDO21X005
5Start #004EDO21X004END DOOR OPERATOR (EDO)FUJ SY490062FUJ SY490062 EDO21X004
61005EDO21X005END DOOR OPERATOR (EDO)FUJ SY490062FUJ SY490062 EDO21X005
7Count
85
9Item
10EDO
11
12Desc
13END DOOR OPERATOR (EDO)
14
15Rev
16N/A
17
18Company
19N/A
20
21Part No.
22FUJ SY490062
23
24Print
25SEM002231-09
26
27Month Format
28X
EDO
 
Upvote 0
I've been trying to figure out a work around on this issue and still have not come up with anything of value out of it. When I active this it dates everything for todays date instead of just searching, removing duplicates, then adding a date to the right of the log. Everything else works fine but this one function.
VBA Code:
Sub CopyPasteEtc()
'
    If LogToSourceWorkbook = True Then
        SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & "2", SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & Rows.Count).End(xlUp)).Copy  ' Copy Column Data to Clipboard
'
        With SourceWorkbookSheetToCopyTo                                                ' Paste results to source workbook
            .Range(ColumnToCopyTo & "1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues   ' Paste Data from Source Column to End of Destination Column
            .Range(ColumnToCopyTo & "2", SourceWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp)).RemoveDuplicates 1    ' Remove Duplicates from Destination Column
            .Range(DateColumn & "2:" & DateColumn & SourceWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp).Row).Value = Date   ' Add Today's Date to next column
        End With
    End If
'
'------------------------------
'
    If LogToDestinationWorkbook = True Then
        SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & "2", SourceWorkbookSheetToCopyFrom.Range(ColumnToCopyFrom & Rows.Count).End(xlUp)).Copy  ' Copy Column Data to Clipboard
'
        With DestinationWorkbookSheetToCopyTo                                           ' Paste results to destination workbook
            .Range(ColumnToCopyTo & "1048576").End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues   ' Paste Data from Source Column to End of Destination Column
            .Range(ColumnToCopyTo & "2", DestinationWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp)).RemoveDuplicates 1    ' Remove Duplicates from Destination Column
            .Range(DateColumn & "2:" & DateColumn & DestinationWorkbookSheetToCopyTo.Range(ColumnToCopyTo & Rows.Count).End(xlUp).Row).Value = Date   ' Add Today's Date to next column
        End With
    End If
End Sub
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,176
Members
453,021
Latest member
Justyna P

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top