VBA Copy and Paste With Duplicates

[pahickham]

Hello All,

I'm in need of some input. My VBA skills are sub-par at best. I've assembled this code from basic research and it works but is glitchy, probably due to the multiple activate sheets portion. However, I need to add in the capability of clearing non-duplicate on the "2B Board Items" work sheet after every click of the command button. For instance if a cell from Column D of "All Data" is the same as a cell from column D for "2B Board Items" then don't delete it. Any help is appreciated.

Also any help on making the Macro more efficient would be appreciated

Private Sub CommandButton2_Click()

a = Worksheets("All Data").Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a

If Worksheets("All Data").Cells(i, 8).Value > 0 Then

Worksheets("All Data").Rows(i).Copy
Worksheets("2B Board Items").Activate
b = Worksheets("2B Board Items").Cells(Rows.Count, 1).End(xlUp).Row
Worksheets("2B Board Items").Cells(b + 1, 1).Select
ActiveSheet.Paste
Worksheets("All Data").Activate

End If

Application.CutCopyMode = False

Next

Worksheets("2B Board Items").Activate
ThisWorkbook.Worksheets("2B Board Items").Cells(1, 1).Select

End Sub

 

[pahickham]

I need it to evaluate the cells from column H in "All Data"
If it equals 0 then don't copy and paste to "2B Board Items".
If equals 0 after 2nd set of inputs remove it form the "2B Board Items"
If it's greater than 0 then copy and paste columns A through F on "2B Board Items"
If greater than 0 and has already been posted don't allow for a duplicate to be formed and keep the hand typed data from H to Z

 

[JLGWhiz]

Since you refuse to answer my specific questions, I cannot continue to spend time on this thread. Perhaps someone else will try to help you.
Regards, JLG

 

[pahickham]

You asked me which cells I wanted evaluated. My opening sentence said, "I need it to evaluate the cells from column H in "All Data"" I literally just told you exactly what I needed. It literally says evaluate for column H in that message above 2x.

 

[JLGWhiz]

I did not see that post. Appar3ently it had gone to page 2 of the thread and I did not catch it. Here is a revised version for you to try. This uis for the second and subsequent runs.

Private Sub CommandButton2_Click()
Dim c As Range, a As Long, a = Worksheets("All Data").Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In Sheets("All Data").Range(H2", Sheets("All Data").Cells(Rows.Count, 8).End(xlUp))        
            If c.Value <> 0 And c.Value <>  "" Then
                c.EntireRow.ClearContents
            End If           
    Next
    For i = 2 To a
        If Worksheets("All Data").Cells(i, 8).Value > 0 Then
            Worksheets("All Data").Rows(i).Copy Worksheets("2B Board Items") _
            .Cells(Rows.Count, 1).End(xlUp)()
        End If
        Application.CutCopyMode = False
    Next
Worksheets("2B Board Items").Activate
ThisWorkbook.Worksheets("2B Board Items").Cells(1, 1).Select
End Sub

 

[pahickham]

Thanks for the reply.

This new code ended up explicitly deleting the cells in "All Data" where H>0 and nothing was posted to "2B Board Items"
Instead I need it to delete the data from the "2B Board Items" sheet, the "All Data" sheet should never lose data.
The "2B Board Items" sheet should be cleared after every click minus the duplicates.

Is it possible to set the copy and paste range from "All Data" to Columns A:G instead of the whole row so it doesn't copy over row H?

 

[pahickham]

So essentially the

  If c.Value <> 0 And c.Value <>  "" Then
                c.EntireRow.ClearContents
            End If

needs to be changed to back to

 If c.Value = 0 Then

and the

c.EntireRow.ClearContents

needs to be setup to delete from the corresponding row in "2B Board Items", so it's not deleting from "All Data"

 

[JLGWhiz]

Maybe this will do it

Private Sub CommandButton2_Click()
Dim c As Range, a As Long, fn As Range
a = Worksheets("All Data").Cells(Rows.Count, 1).End(xlUp).Row
    For Each c In Sheets("All Data").Range("H2:H" & a)
        If c = 0 Then
            Set fn = Sheets("2B Board Items").Range("H:H").Find(c.Value, , xlValues)
            If Not fn Is Nothing Then
                fn.EntireRow.ClearContents
            End If
        End If
    Next
    For i = 2 To a
        If Worksheets("All Data").Cells(i, 8).Value > 0 Then
            Worksheets("All Data").Rows(i).Copy Worksheets("2B Board Items") _
            .Cells(Rows.Count, 1).End(xlUp)()
        End If
        Application.CutCopyMode = False
    Next
Worksheets("2B Board Items").Activate
ThisWorkbook.Worksheets("2B Board Items").Cells(1, 1).Select
End Sub

 

[FatBoyClam]

Sorry - ignore this, posted a comment before realising the thread had gone to two pages.

 

[pahickham]

I'm getting an error on the second portion of the macro, It says subscript is out of range:

Worksheets("All Data").Rows(i).Copy Worksheets("2B Board Items") _
            .Cells(Rows.Count, 1).End(xlUp)()

I closed it up and it still says out of range:

   Worksheets("All Data").Rows(i).Copy Worksheets("2B Board Items").Cells(Rows.Count, 1).End(xlUp)()

 

[JLGWhiz]

That is weird. The 3 disappeared. should be:

Worksheets("All Data").Rows(i).Copy Worksheets("2B Board Items") _
            .Cells(Rows.Count, 1).End(xlUp)(3)

That is shorthand for .Offset(2)