PuntingJawa
Board Regular
- Joined
- Feb 25, 2021
- Messages
- 158
- Office Version
- 365
- 2019
- Platform
- 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.
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
