I'm new to writing VBA and having spent most of the day writing some code, I have finally got it working but it looks horrible. I'm hoping that someone can help me tidy it up.
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.
Ideally I need the code to look tidy and professional and probably most importantly be understandable to anyone looking at it, whether that be someone else or me in a years time - when I've forgotten what I did.
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