Excel VBA Skipping Copied Cells

[Rymare]

I have a macro that runs through my source sheet "CleanData" and copies any row in that sheet to the active sheet provided the active sheet's name is in column A. It skips over rows that do not meet this criteria. So far, so good. The problem I'm having is that when you run the macro again it does not recheck the active sheet to see if the same row is already recorded. So it gives me duplicates.


I'm using fake data as the actual data is protected info, but needless to say the list under the Inspector heading is extremely long which is why I'm trying to avoid fixed ranges (like "A5:A32" etc) and fixed criteria (having the macro say things like

rngcel.value = "Harry"

for example would cause problems because what if a new inspector gets added on and his name is not Harry? Someone has to go in and change the macro each time a new inspector is added. Instead I use things like

rngcel.value = Activesheet.name

since each inspector gets his/her own sheet).


Here's the flow


You run the macro from the inspectors sheet, in this example, the Sheet named Harry. Harry comes in and runs the macro to see what new work he needs to do:

So far so good:

Well, what if Harry comes in one day and wants to see if Voldemort has given him new work? He needs to update his sheet again to check right?


So he runs the macro again, but now the same work orders are getting copied in with the new ones, and he doesn't need the same info twice:

Here's the code (which was hobbled together from different places--I think even from here--and I made changes) :

Sub CopyColumns()


Dim wsSource As Worksheet
Dim wsDestin As Worksheet
Dim lngDestinRow As Long
Dim rngSource As Range
Dim rngCel As Range




Set wsSource = Sheets("CleanData")     'Edit "Sheet1" to your source sheet name
Set wsDestin = ActiveSheet




With wsSource
    'Following line assumes column headers in Source worksheet so starts at row2
    Set rngSource = .Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))


End With


For Each rngCel In rngSource
    If rngCel.Value = ActiveSheet.name Then
        With wsDestin
            'Following line assumes column headers in Destination worksheet
            lngDestinRow = .Cells(.Rows.Count, "A").End(xlUp).Offset(1, 0).Row
            rngCel.EntireRow.copy Destination:=wsDestin.Cells(lngDestinRow, "A")
        End With
    End If
Next rngCel


End Sub

I tried to filter out the duplicates using:

And IsError(Application.Match(rngCel.Value, rowname, 0))

in this line of code:

For Each rngCel In rngSource
        If rngCel.Value = ActiveSheet.name Then

And I tried to define rowname as a range of all previous rows in the sheet. It did not work.

Based on a suggestion from stackoverflow I made this:

 With wsDestin        Set destrng = .Range(.Cells(2, "G"), .Cells(.Rows.Count, "G").End(x1Up))
    End With
   
    
    For Each rngCel In rngSource
        If rngCel.Value = ActiveSheet.name And rngCel.Value <> destrng Then

It also did not work.


I initially had formulas within each sheets' cells that gathered all this data but it severely slowed down an already bogged down excel file.

Here's a link to where I asked this question on stackoverflow
https://stackoverflow.com/questions/49947378/macro-to-skip-rows-already-copied

 

[igold]

I have a question, if Harry is not making any changes to the information that appears on his sheet, and the only changes that occur on the "Inspectors" sheet is the addition of new information being appended to the bottom of the "Inspectors" sheet, why not just let the macro clear the "Harry" sheet and recopy all the "Harry" rows to the "Harry" sheet each time the macro is run.

If this does not work because Harry does indeed make changes to his rows after they are pulled from the Inspector sheet, then are there any columns or combination of columns that will always indicate that that row is a unique row. Looking at your sample fictitious data perhaps the columns "F" & "G" will never duplicate...

 

[Rymare]

Harry does make changes. He has to put data in about when something was sent to contractor, but nothing else. Column G is a unique column that never repeats values in the main sheet and should never be edited by Harry. I basically want new data to be appended to the bottom on Harry's sheet, because in the master sheet--where everyone's names are mixed together--the date sent to contractor will be pulled from the individual inspectors sheet (in this case Harry's) and then updated to the master sheet via a formula I already know how to write.

Does this help? It sounds confusing reading it back, but if you need more info I'm happy to provide it.

 

[igold]

Does this get you close to what you want to do...

Sub CopyColumns()


    Dim wsSource As Worksheet: Set wsSource = Sheets("CleanData")
    Dim wsDestin As Worksheet: Set wsDestin = ActiveSheet
    Dim ldestlRow As Long, i As Long
    Dim ins As Variant
    Dim h As String, won As String
    Dim wo As Range


    h = wsDestin.Name
    ldestlRow = wsDestin.Cells(Rows.Count, 1).End(xlUp).Row + 1
    ins = wsSource.UsedRange
    For i = 2 To UBound(ins)
        won = ins(i, 7)
        Set wo = Range("G2:G" & ldestlRow).Find(what:=won)
        If wo Is Nothing And ins(i, 1) = h Then
            ldestlRow = wsDestin.Cells(Rows.Count, 1).End(xlUp).Row + 1
            wsSource.Range("A" & i).EntireRow.Copy wsDestin.Range("A" & ldestlRow)
        End If
    Next
        
End Sub

 

[Rymare]

Does this get you close to what you want to do...

Sub CopyColumns()


    Dim wsSource As Worksheet: Set wsSource = Sheets("CleanData")
    Dim wsDestin As Worksheet: Set wsDestin = ActiveSheet
    Dim ldestlRow As Long, i As Long
    Dim ins As Variant
    Dim h As String, won As String
    Dim wo As Range


    h = wsDestin.Name
    ldestlRow = wsDestin.Cells(Rows.Count, 1).End(xlUp).Row + 1
    ins = wsSource.UsedRange
    For i = 2 To UBound(ins)
        won = ins(i, 7)
        Set wo = Range("G2:G" & ldestlRow).Find(what:=won)
        If wo Is Nothing And ins(i, 1) = h Then
            ldestlRow = wsDestin.Cells(Rows.Count, 1).End(xlUp).Row + 1
            wsSource.Range("A" & i).EntireRow.Copy wsDestin.Range("A" & ldestlRow)
        End If
    Next
        
End Sub

Works like a charm! A million thanks!!!

 

[igold]

Happy to help. I am glad you got it squared away. Thanks for the feedback.