BENSON
12-24-2007, 05:04 AM
The code below copies and pastes data to a spread sheet .I was wondering if it is possible that I could insert some further code to stop the same information being pasted ie if the macro is run twice and the same information is going to be pasted some kind of error message should show to indicate a duplicate row has been pasted.
Thanks
Private Sub Workbook_BeforeClose(Cancel As Boolean)
a = MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", _
vbYesNo)
If a = vbYes Then
Cancel = True
Dim WsTgt As Excel.Worksheet
Dim rngCopy As Excel.Range
Application.ScreenUpdating = False
Set WsTgt = Workbooks("Gardens History.xls").Sheets(1)
With WsTgt.Range("A" & NextEmptyRow(WsTgt))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
ActiveSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
ActiveSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
ActiveSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues
Set rngCopy = ActiveSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
Else
Rem Cancel = True:Rem If you don't want No=Close
End If
End Sub
Function NextEmptyRow(Wks As Worksheet) As Long
Dim Rng As Range
Set Rng = Wks.Range("A" & Wks.Rows.Count).End(xlUp)
If Rng <> "" Then Set Rng = Rng.Offset(1)
NextEmptyRow = Rng.Row
End Function
Private Sub Workbook_Open()
End Sub
Thanks
Private Sub Workbook_BeforeClose(Cancel As Boolean)
a = MsgBox("ARE YOU READY TO UPDATE THE HISTORY FILE?", _
vbYesNo)
If a = vbYes Then
Cancel = True
Dim WsTgt As Excel.Worksheet
Dim rngCopy As Excel.Range
Application.ScreenUpdating = False
Set WsTgt = Workbooks("Gardens History.xls").Sheets(1)
With WsTgt.Range("A" & NextEmptyRow(WsTgt))
.Value = Date
.NumberFormat = "ddd dd mmm yy"
' Add C285 and C286
ActiveSheet.Range("C284").Copy
.Offset(, 1).PasteSpecial xlPasteValues
ActiveSheet.Range("C286").Copy
.Offset(, 2).PasteSpecial xlPasteValues
ActiveSheet.Range("C288").Copy
.Offset(, 3).PasteSpecial xlPasteValues
Set rngCopy = ActiveSheet.Range("G260:AZ260")
rngCopy.Copy
.Offset(, 4).PasteSpecial xlPasteValues
Application.ScreenUpdating = True
End With
Else
Rem Cancel = True:Rem If you don't want No=Close
End If
End Sub
Function NextEmptyRow(Wks As Worksheet) As Long
Dim Rng As Range
Set Rng = Wks.Range("A" & Wks.Rows.Count).End(xlUp)
If Rng <> "" Then Set Rng = Rng.Offset(1)
NextEmptyRow = Rng.Row
End Function
Private Sub Workbook_Open()
End Sub