Skip to main content
deleted 1 character in body
Source Link

The code simply copies certain cells from onceone sheet into another. If a particular cell in the source sheet contains the word "Accepted". Columns A of the source and destination sheets contain a unique reference and that data is only copied across if the unique reference is not already in the destination data. In addition, my code adds the date at which each entry is made in the destination sheet.

The code simply copies certain cells from once sheet into another. If a particular cell in the source sheet contains the word "Accepted". Columns A of the source and destination sheets contain a unique reference and that data is only copied across if the unique reference is not already in the destination data. In addition, my code adds the date at which each entry is made in the destination sheet.

The code simply copies certain cells from one sheet into another. If a particular cell in the source sheet contains the word "Accepted". Columns A of the source and destination sheets contain a unique reference and that data is only copied across if the unique reference is not already in the destination data. In addition, my code adds the date at which each entry is made in the destination sheet.

Rollback to Revision 2
Source Link
Mathieu Guindon
  • 75.6k
  • 18
  • 195
  • 469
Public Sub UpdateAcceptedChangeRequests()  With Application   .ScreenUpdating = False   .EnableEvents = False  End With  On Error GoTo errorHandler:  Dim varAnswer As String varAnswer = MsgBox("Are you sure you want to update the Accepted Change Requests List?", vbYesNo, "Update Accepted Change Requests")   If varAnswer = vbNo Then MsgBox ("No changes saved")   With Application   .ScreenUpdating = True   .EnableEvents = True   End With   Exit Sub   End If  Dim SourceRange As Range Dim, DestRange As Range  Dim DestSheet As Worksheet Dim, SourceSheet As Worksheet  Dim LastRowDestSheet As Long Dim, i As Long Dim, LastRowSourceSheet As Long Set DestSheet = ThisWorkbook.Worksheets("Accepted Change Requests") Set SourceSheet = ThisWorkbook.Worksheets("All Change Requests")   LastRowDestSheet = DestSheet.Cells(DestSheet.Rows.Count, "A").End(xlUp).Row   LastRowSourceSheet = SourceSheet.Cells(SourceSheet.Rows.Count, "E").End(xlUp).Row For i = 2 To LastRowSourceSheet   If SourceSheet.Range("E" & i).Value = "Accepted" Then   If Evaluate("ISERROR(MATCH(A" & i & ",'Accepted Change Requests'!A:A,0))") Then   DestSheet.Range("A" & LastRowDestSheet + 1 & ":D" & LastRowDestSheet + 1).Value = _ SourceSheet.Range("A" & i & ":D" & i).Value   With DestSheet.Range("E" & LastRowDestSheet + 1)   .Value = Date   .NumberFormat = "dd/mm/yyyy"   End With   LastRowDestSheet = LastRowDestSheet + 1   End If   End If Next i With Application  With Application  .ScreenUpdating = True   .EnableEvents = True End With  End With Exit Sub errorHandler: MsgBox ("There was an error adding this Change Request") Resume Next  With Application   .ScreenUpdating = True   .EnableEvents = True  End With End Sub 
Public Sub UpdateAcceptedChangeRequests()  With Application   .ScreenUpdating = False   .EnableEvents = False  End With  On Error GoTo errorHandler  Dim varAnswer As String varAnswer = MsgBox("Are you sure you want to update the Accepted Change Requests List?", vbYesNo, "Update Accepted Change Requests")   If varAnswer = vbNo Then MsgBox ("No changes saved")   With Application   .ScreenUpdating = True   .EnableEvents = True   End With   Exit Sub   End If  Dim SourceRange As Range Dim DestRange As Range  Dim DestSheet As Worksheet Dim SourceSheet As Worksheet  Dim LastRowDestSheet As Long Dim i As Long Dim LastRowSourceSheet As Long Set DestSheet = ThisWorkbook.Worksheets("Accepted Change Requests") Set SourceSheet = ThisWorkbook.Worksheets("All Change Requests") LastRowDestSheet = DestSheet.Cells(DestSheet.Rows.Count, "A").End(xlUp).Row LastRowSourceSheet = SourceSheet.Cells(SourceSheet.Rows.Count, "E").End(xlUp).Row For i = 2 To LastRowSourceSheet   If SourceSheet.Range("E" & i).Value = "Accepted" Then   If Evaluate("ISERROR(MATCH(A" & i & ",'Accepted Change Requests'!A:A,0))") Then   DestSheet.Range("A" & LastRowDestSheet + 1 & ":D" & LastRowDestSheet + 1).Value = _ SourceSheet.Range("A" & i & ":D" & i).Value   With DestSheet.Range("E" & LastRowDestSheet + 1)   .Value = Date   .NumberFormat = "dd/mm/yyyy"   End With   LastRowDestSheet = LastRowDestSheet + 1   End If   End If Next i With Application  .ScreenUpdating = True   .EnableEvents = True End With  Exit Sub errorHandler: MsgBox "There was an error adding this Change Request" Resume Next  With Application   .ScreenUpdating = True   .EnableEvents = True  End With End Sub 
Public Sub UpdateAcceptedChangeRequests() With Application .ScreenUpdating = False .EnableEvents = False End With On Error GoTo errorHandler: Dim varAnswer As String varAnswer = MsgBox("Are you sure you want to update the Accepted Change Requests List?", vbYesNo, "Update Accepted Change Requests") If varAnswer = vbNo Then MsgBox ("No changes saved") With Application .ScreenUpdating = True .EnableEvents = True End With Exit Sub End If Dim SourceRange As Range, DestRange As Range Dim DestSheet As Worksheet, SourceSheet As Worksheet Dim LastRowDestSheet As Long, i As Long, LastRowSourceSheet As Long Set DestSheet = ThisWorkbook.Worksheets("Accepted Change Requests") Set SourceSheet = ThisWorkbook.Worksheets("All Change Requests")   LastRowDestSheet = DestSheet.Cells(DestSheet.Rows.Count, "A").End(xlUp).Row   LastRowSourceSheet = SourceSheet.Cells(SourceSheet.Rows.Count, "E").End(xlUp).Row For i = 2 To LastRowSourceSheet If SourceSheet.Range("E" & i).Value = "Accepted" Then If Evaluate("ISERROR(MATCH(A" & i & ",'Accepted Change Requests'!A:A,0))") Then DestSheet.Range("A" & LastRowDestSheet + 1 & ":D" & LastRowDestSheet + 1).Value = _ SourceSheet.Range("A" & i & ":D" & i).Value With DestSheet.Range("E" & LastRowDestSheet + 1) .Value = Date .NumberFormat = "dd/mm/yyyy" End With LastRowDestSheet = LastRowDestSheet + 1 End If End If Next i With Application  .ScreenUpdating = True .EnableEvents = True End With Exit Sub errorHandler: MsgBox ("There was an error adding this Change Request") Resume Next With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 
Correcting indentation as suggested by first answerer.
Source Link
Public Sub UpdateAcceptedChangeRequests()  With Application   .ScreenUpdating = False   .EnableEvents = False  End With  On Error GoTo errorHandler:  Dim varAnswer As String varAnswer = MsgBox("Are you sure you want to update the Accepted Change Requests List?", vbYesNo, "Update Accepted Change Requests")   If varAnswer = vbNo Then MsgBox ("No changes saved")   With Application   .ScreenUpdating = True   .EnableEvents = True   End With   Exit Sub   End If  Dim SourceRange As Range,  Dim DestRange As Range  Dim DestSheet As Worksheet,  Dim SourceSheet As Worksheet  Dim LastRowDestSheet As Long,  Dim i As Long,  Dim LastRowSourceSheet As Long Set DestSheet = ThisWorkbook.Worksheets("Accepted Change Requests") Set SourceSheet = ThisWorkbook.Worksheets("All Change Requests")   LastRowDestSheet = DestSheet.Cells(DestSheet.Rows.Count, "A").End(xlUp).Row   LastRowSourceSheet = SourceSheet.Cells(SourceSheet.Rows.Count, "E").End(xlUp).Row For i = 2 To LastRowSourceSheet   If SourceSheet.Range("E" & i).Value = "Accepted" Then   If Evaluate("ISERROR(MATCH(A" & i & ",'Accepted Change Requests'!A:A,0))") Then   DestSheet.Range("A" & LastRowDestSheet + 1 & ":D" & LastRowDestSheet + 1).Value = _ SourceSheet.Range("A" & i & ":D" & i).Value   With DestSheet.Range("E" & LastRowDestSheet + 1)   .Value = Date   .NumberFormat = "dd/mm/yyyy"   End With   LastRowDestSheet = LastRowDestSheet + 1   End If   End If Next i With Application  With Application  .ScreenUpdating = True   .EnableEvents = True   End With  Exit Sub errorHandler: MsgBox ("There was an error adding this Change Request") Resume Next  With Application   .ScreenUpdating = True   .EnableEvents = True  End With End Sub 
Public Sub UpdateAcceptedChangeRequests() With Application .ScreenUpdating = False .EnableEvents = False End With On Error GoTo errorHandler: Dim varAnswer As String varAnswer = MsgBox("Are you sure you want to update the Accepted Change Requests List?", vbYesNo, "Update Accepted Change Requests") If varAnswer = vbNo Then MsgBox ("No changes saved") With Application .ScreenUpdating = True .EnableEvents = True End With Exit Sub End If Dim SourceRange As Range, DestRange As Range Dim DestSheet As Worksheet, SourceSheet As Worksheet Dim LastRowDestSheet As Long, i As Long, LastRowSourceSheet As Long Set DestSheet = ThisWorkbook.Worksheets("Accepted Change Requests") Set SourceSheet = ThisWorkbook.Worksheets("All Change Requests")   LastRowDestSheet = DestSheet.Cells(DestSheet.Rows.Count, "A").End(xlUp).Row   LastRowSourceSheet = SourceSheet.Cells(SourceSheet.Rows.Count, "E").End(xlUp).Row For i = 2 To LastRowSourceSheet If SourceSheet.Range("E" & i).Value = "Accepted" Then If Evaluate("ISERROR(MATCH(A" & i & ",'Accepted Change Requests'!A:A,0))") Then DestSheet.Range("A" & LastRowDestSheet + 1 & ":D" & LastRowDestSheet + 1).Value = _ SourceSheet.Range("A" & i & ":D" & i).Value With DestSheet.Range("E" & LastRowDestSheet + 1) .Value = Date .NumberFormat = "dd/mm/yyyy" End With LastRowDestSheet = LastRowDestSheet + 1 End If End If Next i With Application  .ScreenUpdating = True .EnableEvents = True   End With Exit Sub errorHandler: MsgBox ("There was an error adding this Change Request") Resume Next With Application .ScreenUpdating = True .EnableEvents = True End With End Sub 
Public Sub UpdateAcceptedChangeRequests()  With Application   .ScreenUpdating = False   .EnableEvents = False  End With  On Error GoTo errorHandler  Dim varAnswer As String varAnswer = MsgBox("Are you sure you want to update the Accepted Change Requests List?", vbYesNo, "Update Accepted Change Requests")   If varAnswer = vbNo Then MsgBox ("No changes saved")   With Application   .ScreenUpdating = True   .EnableEvents = True   End With   Exit Sub   End If  Dim SourceRange As Range  Dim DestRange As Range  Dim DestSheet As Worksheet  Dim SourceSheet As Worksheet  Dim LastRowDestSheet As Long  Dim i As Long  Dim LastRowSourceSheet As Long Set DestSheet = ThisWorkbook.Worksheets("Accepted Change Requests") Set SourceSheet = ThisWorkbook.Worksheets("All Change Requests") LastRowDestSheet = DestSheet.Cells(DestSheet.Rows.Count, "A").End(xlUp).Row LastRowSourceSheet = SourceSheet.Cells(SourceSheet.Rows.Count, "E").End(xlUp).Row For i = 2 To LastRowSourceSheet   If SourceSheet.Range("E" & i).Value = "Accepted" Then   If Evaluate("ISERROR(MATCH(A" & i & ",'Accepted Change Requests'!A:A,0))") Then   DestSheet.Range("A" & LastRowDestSheet + 1 & ":D" & LastRowDestSheet + 1).Value = _ SourceSheet.Range("A" & i & ":D" & i).Value   With DestSheet.Range("E" & LastRowDestSheet + 1)   .Value = Date   .NumberFormat = "dd/mm/yyyy"   End With   LastRowDestSheet = LastRowDestSheet + 1   End If   End If Next i With Application  .ScreenUpdating = True   .EnableEvents = True End With  Exit Sub errorHandler: MsgBox "There was an error adding this Change Request" Resume Next  With Application   .ScreenUpdating = True   .EnableEvents = True  End With End Sub 
deleted 7 characters in body; edited tags; edited title
Source Link
Jamal
  • 35.2k
  • 13
  • 134
  • 238
Loading
Source Link
Loading