Excel 07 VBA Resize Message Box Prompt Error

[NeedyHelpExcelMan]

Hello all,

I seem to be having an error, I am running code that loops through column AR, checks for a value and if the value is present, copy and paste the row to a corresponding sheet. I am using the Resize function to define how many cells of the row I wish to copy. However, for some reason, everytime the row is copied, the corresponding sheet is selected, instead of pasting - a message box asking me to "Update Values" comes up along with the option to browse for an Excel file. It is very weird - I believe it is the Resize function that is causing this issue because when I subsituted Offset for Resize, the message box promt went away. I am attaching code below. If anyone has had this issue and can advice that would be great. I need to keep using the Resize function without having this nasty message box appear.

 Sheets("Current Week Tracking").Select
    ' Find the last row of data
    FinalRow = Cells(Rows.Count, 44).End(xlUp).Row
    ' Loop through each row
    For x = 2 To FinalRow
        ' Decide if to copy based on column D
        ThisValue = Cells(x, 44).Value
        If ThisValue = "0" Then
            Cells(x, 1).Resize(RowSize:=1, ColumnSize:=43).Copy
            Sheets("Actives").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Current Week Tracking").Select
        ElseIf ThisValue = "1" Then
            Cells(x, 1).Resize(RowSize:=1, ColumnSize:=43).Copy
            Sheets("Notice Letter").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Current Week Tracking").Select
        ElseIf ThisValue = "2" Then
            Cells(x, 1).Resize(RowSize:=1, ColumnSize:=43).Copy
            Sheets("Letter 1").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Current Week Tracking").Select
        
        ElseIf ThisValue = "3" Then
            Cells(x, 1).Resize(RowSize:=1, ColumnSize:=43).Copy
            Sheets("Letter 2").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Current Week Tracking").Select
        
        ElseIf ThisValue = "4" Then
            Cells(x, 1).Resize(RowSize:=1, ColumnSize:=43).Copy
            Sheets("Cancel Letter").Select
            NextRow = Cells(Rows.Count, 1).End(xlUp).Row + 1
            Cells(NextRow, 1).Select
            ActiveSheet.Paste
            Sheets("Current Week Tracking").Select
        End If
    Next x

Thank you in advance for any help, insight, or advice.

 

[shg]

Try this:

Sub x()
    Dim iRow        As Long
    Dim wks         As Worksheet
    Dim bBad        As Boolean

    Worksheets("Current Week Tracking").Select
    For iRow = 2 To Cells(Rows.Count, "AR").End(xlUp).Row
        bBad = False
        Rows(iRow).Range("A1:AQ1").Copy

        Select Case Cells(iRow, 44).Value
            Case 0
                Set wks = Worksheets("Actives")
            Case 1
                Set wks = Worksheets("Notice Letter")
            Case 2
                Set wks = Worksheets("Letter 1")
            Case 3
                Set wks = Worksheets("Letter 2")
            Case 4
                Set wks = Worksheets("Cancel Letter")
            Case Else
                bBad = True
                Cells(iRow, "AR").Select
                MsgBox "Oops!"
        End Select

        If Not bBad Then wks.Cells(Rows.Count, "A").End(xlUp)(2).PasteSpecial
    Next iRow
End Sub

 

[Norie]

Little confused, your code explicitly selects the corresponding sheet(s).

If you don't want that to happen remove the code that selects the sheet(s).

For example.

    With Sheets("Current Week Tracking")
        ' Find the last row of data
        FinalRow = .Cells(Rows.Count, 44).End(xlUp).Row
        ' Loop through each row
        For x = 2 To FinalRow
            ' Decide if to copy based on column D
            ThisValue = .Cells(x, 44).Value
            If ThisValue = "0" Then
                .Cells(x, 1).Resize(RowSize:=1, ColumnSize:=43).Copy Sheets("Actives").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            ElseIf ThisValue = "1" Then
                .Cells(x, 1).Resize(RowSize:=1, ColumnSize:=43).Copy Sheets("Notice Letter").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            ElseIf ThisValue = "2" Then
                .Cells(x, 1).Resize(RowSize:=1, ColumnSize:=43).Copy Sheets("Letter 1").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            ElseIf ThisValue = "3" Then
                .Cells(x, 1).Resize(RowSize:=1, ColumnSize:=43).Copy Sheets("Letter 2").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            ElseIf ThisValue = "4" Then
                .Cells(x, 1).Resize(RowSize:=1, ColumnSize:=43).Copy Sheets("Cancel Letter").Cells(Rows.Count, 1).End(xlUp).Offset(1)
            End If
        Next x
    End With