0

So, I have written some VBA in excel to copy some cells to another worksheet within my Excel workbook, but I am having some trouble with the code copying the entry to the next available row. The code I have works great as long as the first available row is empty, but after that it throws a "Run-time error '1004': Application-defined or object-defined error". I believe that the error is in my use of the (xlDown) search. Any advice would be appreciated.

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("F5:F100")) Is Nothing Then
    Select Case Target.Value
        Case "Archive"
            Archive
    End Select
End If

End Sub

Sub Archive()
Dim Wishlist As Worksheet, Archive As Worksheet

Set Wishlist = Sheet1
Set Archive = Sheet2


Dim issueType As Range, preparedBy As Range, description As Range, jira As Range, jiraNum As Range
Dim currentStatus As Range

Set issueType = ActiveCell.Offset(0, -5)
Set preparedBy = ActiveCell.Offset(0, -4)
Set description = ActiveCell.Offset(0, -3)
Set jira = ActiveCell.Offset(0, -2)
Set jiraNum = ActiveCell.Offset(0, -1)
Set currentStatus = ActiveCell




Dim DestCell As Range


If Archive.Range("A5") = "" Then 'If A5 is empty
    Set DestCell = Archive.Range("A5") '...then destination cell is A5
Else
    Set DestCell = Archive.Range("A5").End(xlDown).Offset(1, 0) '...otherwise the next empty row
End If

'Ensure that the item needs to be archived
If currentStatus = "Archive" Then
    Dim answer As Integer
    answer = MsgBox("Are you SURE you want to archive this item?", vbYesNo)
    If answer = vbYes Then
        issueType.Copy DestCell
        preparedBy.Copy DestCell.Offset(0, 1)
        description.Copy DestCell.Offset(0, 2)
        jira.Copy DestCell.Offset(0, 3)
        jiraNum.Copy DestCell.Offset(0, 4)
        DestCell.Offset(0, 5) = Date
    
              
        'Clear the contents in the Wishlist worksheet
        issueType.ClearContents
        preparedBy.ClearContents
        description.ClearContents
        jira.ClearContents
        jiraNum.ClearContents
        currentStatus.ClearContents
    End If
Else
    MsgBox "Archive Cancelled"
End If

End Sub

I could have sworn that at one time this worked, but apparently not today! Thanks again for all that this community does - you guys rock.

Pherix
  • 31
  • 7
  • 1
    `Set DestCell = Archive.Range("A" & Archive.Rows.Count).End(xlUp).Offset(1)` – BigBen Oct 03 '22 at 19:17
  • if `A5` is not `""` but `A6` is `""` then it will go to the bottom of the sheet and you cannot offset `+1` if you are at the bottom of the sheet. – Scott Craner Oct 03 '22 at 19:17
  • 1
    @BigBen - As always, you come through with a solution. Can't thank you enough - again. – Pherix Oct 03 '22 at 20:55

0 Answers0