VBA Copying Rows based on Condition, copying the value only.

[philldavis11]

Ok I do not use VBA pretty much ever, but was asked to add an "archive" feature into my workbook. Below is the code that I found online, it works, but it also brings over formulas and I am not too sure what I need to do to adjust it.

So in column "z" I have a "True" or "False" condition formula. In a perfect world, I want rows where "True" in column Z to be sent to the Archive sheet when I hit a button. In my live work version of the sheet, I have formulas throughout, and want to avoid any "#N/A" and want all the values that were present in that row only to appear in my archive sheet. Can someone help me out?

I scrubbed the excel sheet

[FONT=Calibri]Private Sub CommandButton1_Click()
 
    Dim xCell As Range
    Dim I As Long
    Dim J As Long
    Dim K As Long
    I = Worksheets("Main").UsedRange.Rows.Count
    J = Worksheets("Archive").UsedRange.Rows.Count
    If J = 1 Then
       If Application.WorksheetFunction.CountA(Worksheets("Archive").UsedRange) = 0 Then J = 0
    End If
    Set xRg = Worksheets("Main").Range("Z1:Z" & I)
    On Error Resume Next
    Application.ScreenUpdating = False
    For K = 1 To xRg.Count
        If CStr(xRg(K).Value) = "True" Then
            xRg(K).EntireRow.Copy Destination:=Worksheets("Archive").Range("A" & J + 1)
            xRg(K).EntireRow.Delete
            If CStr(xRg(K).Value) = "Done" Then
                K = K - 1
            End If
            J = J + 1
        End If
    Next
    Application.ScreenUpdating = True
 
End Sub[/FONT]

 

[Jamie McMillan]

Hello,

I am just heading out at the moment. I quickly read the code. You just need to paste the values instead of copying the cells. Change this line:-

xRg(K).EntireRow.Copy Destination:=Worksheets("Archive").Range("A" & J + 1)

To this:-

xRg(K).EntireRow.Copy   'copies the row
Worksheets("Archive").Range("A" & J + 1).select   'Selects the next cell on the Archive sheet
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _   'Pastes the values of the cells
        :=False, Transpose:=False

That should work, I haven't tried it; I don't have the time at the moment.

Jamie

 

[philldavis11]

Thanks!
I am assuming after the "SkipBlanks" I should remove the "_" underscore? I was getting an error about a parameter. I tried to remove the underscore and run it, but its not working unfortunately.

xRg(K).EntireRow.Copy   'copies the row
Worksheets("Archive").Range("A" & J + 1).select   'Selects the next cell on the Archive sheet
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks [COLOR=rgb(184, 49, 47)]_[/COLOR]   'Pastes the values of the cells
        :=False, Transpose:=False

 

[philldavis11]

It removes the records based on the value in Column "Z", but does not paste those selection into the next blank row on my "archive" sheet.

 

[Fluff]

Hi & welcome to MrExcel.
is the number of columns always the same? If so what is the last used column?

 

[Fluff]

With your existing code try

        If CStr(xRg(k).Value) = "True" Then
            xRg(k).EntireRow.Copy
            Worksheets("Archive").Range("A" & j + 1).PasteSpecial xlPasteValues
            xRg(k).EntireRow.Delete
            If CStr(xRg(k).Value) = "Done" Then
                k = k - 1
            End If
            j = j + 1
        End If

Also if you want to format your code please use the Rich icon & not the VBA icon.