Excel VBA Skipping Copied Cells

Rymare

New Member
Joined
Apr 20, 2018
Messages
37
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
Code:
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
Code:
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:


J0mbY.png



So far so good:

P4up7.png



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:


TbG9T.png



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


Code:
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:


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


in this line of code:


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:

Code:
 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
 
Last edited by a moderator:

Excel Facts

Waterfall charts in Excel?
Office 365 customers have access to Waterfall charts since late 2016. They were added to Excel 2019.
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...
 
Upvote 0
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.
 
Upvote 0
Does this get you close to what you want to do...

Code:
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
 
Upvote 0
Does this get you close to what you want to do...

Code:
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!!!
 
Upvote 0
Happy to help. I am glad you got it squared away. Thanks for the feedback.
 
Upvote 0

Forum statistics

Threads
1,223,779
Messages
6,174,492
Members
452,567
Latest member
ONEIL290

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top