Craig_Moore
Board Regular
- Joined
- Dec 12, 2018
- Messages
- 64
- Office Version
- 2019
- Platform
- Windows
Hi All
I am using the below code to transfer data from one sheet to another, the code is supposed to check if the date that is being downloaded has already downloaded and pop up a box to say over wright yes/no but this is always coming up whether the date is there or not any help would be much appreciated
I am using the below code to transfer data from one sheet to another, the code is supposed to check if the date that is being downloaded has already downloaded and pop up a box to say over wright yes/no but this is always coming up whether the date is there or not any help would be much appreciated
VBA Code:
Private Sub CommandButton2_Click()
Workbooks.Open "\\duerrsfile\SS\01 PNB Production\OEE SHEETS\02. DOWN TIME SHEET\DOWN TIME SHEET PNB 2020 .xlsx"
Application.ScreenUpdating = False
Dim copySheet As Worksheet, pasteSheet As Worksheet, lCol As Long
' LINE 3 COPY PASE CODE,
Set copySheet = ThisWorkbook.Sheets("OVERVIEW")
Set pasteSheet = Workbooks("DOWN TIME SHEET PNB 2020 .xlsx").Sheets("YTD DOWNTIME")
On Error Resume Next
lCol = WorksheetFunction.Match(copySheet.Range("LINE_3_DT").Cells(1, 1), pasteSpecialxlPasteValues.Range("4:4"), 0)
On Error GoTo 0
If lCol > 0 Then
If MsgBox("Duplicate date - overwrite ?", vbYesNo, "") <> vbYes Then GoTo Save
Else
lCol = pasteSheet.Cells(4, pasteSheet.Columns.Count).End(xlToLeft).Column + 1
End If
copySheet.Range("LINE_3_DT").Copy
pasteSheet.Cells(4, lCol).PasteSpecial xlPasteValues ' THE 5 VALUE MUST MATCH THE VALUE 2 LINES OF CODE UP
Application.CutCopyMode = False
Application.ScreenUpdating = True
'save Workbook
Save:
ActiveWorkbook.Save
'LINE 5 COPY CODE PAST CODE
Set copySheet = ThisWorkbook.Sheets("OVERVIEW")
Set pasteSheet = Workbooks("DOWN TIME SHEET PNB 2020 .xlsx").Sheets("YTD DOWNTIME")
On Error Resume Next
lCol = WorksheetFunction.Match(copySheet.Range("LINE_3_DT").Cells(24, 1), pasteSpecialxlPasteValues.Range("24:24"), 0)
On Error GoTo 0
If lCol > 0 Then
If MsgBox("Duplicate date - overwrite ?", vbYesNo, "") <> vbYes Then GoTo Save2
Else
lCol = pasteSheet.Cells(24, pasteSheet.Columns.Count).End(xlToLeft).Column + 1
End If
copySheet.Range("LINE_5_DT").Copy
pasteSheet.Cells(24, lCol).PasteSpecial xlPasteValues ' THE 5 VALUE MUST MATCH THE VALUE 2 LINES OF CODE UP
Application.CutCopyMode = False
Application.ScreenUpdating = True
'save Workbook
Save2:
ActiveWorkbook.Save
'TUBS AND BUCKETS COPY CODE PAST CODE
Set copySheet = ThisWorkbook.Sheets("OVERVIEW")
Set pasteSheet = Workbooks("DOWN TIME SHEET PNB 2020 .xlsx").Sheets("YTD DOWNTIME")
On Error Resume Next
lCol = WorksheetFunction.Match(copySheet.Range("LINE_3_DT").Cells(45, 1), pasteSpecialxlPasteValues.Range("45:45"), 0)
On Error GoTo 0
If lCol > 0 Then
If MsgBox("Duplicate date - overwrite ?", vbYesNo, "") <> vbYes Then GoTo Save3
Else
lCol = pasteSheet.Cells(45, pasteSheet.Columns.Count).End(xlToLeft).Column + 1
End If
copySheet.Range("TUB_DT").Copy
pasteSheet.Cells(45, lCol).PasteSpecial xlPasteValues ' THE 45 VALUE MUST MATCH THE VALUE 2 LINES OF CODE UP
Application.CutCopyMode = False
Application.ScreenUpdating = True
'save Workbook
Save3:
ActiveWorkbook.Save
'Close Workbook
'ActiveWorkbook.Close Savechanges:=True