Excel Guru's

[joelk2]

Hello Folks,

im after some help with excel.

i have a spreadsheet which i can post a link to download if it would help but here is a picture which hopefully will help.

basically what i want to do is copy the rows to the appropriate worksheet based on the values from the G column.

i have it working but every time i run the macro it copies the same rows again.

i basically want it to copy the row and add a number 1 to the duplicate column and then the next time i run it, it ignores the the rows with a number 1 in the duplicate column.

this is the code i have working so far (only have it copying to the first 2 worksheets at the moment to keep it smaller)



Sub Copy()
Dim wsSource As Worksheet
Dim wsRhisiart As Worksheet
Dim wsMarc As Worksheet
Dim wsGrahamIan As Worksheet
Dim wsAdele As Worksheet
Dim wsEther As Worksheet
Dim wsJaspal As Worksheet
Dim wsMartin As Worksheet
Dim lngDestinRow As Long
Dim rngSource As Range
Dim rngCel As Range


Set wsSource = Sheets("Main") 'Edit "Sheet1" to your source sheet name
Set wsRhisiart = Sheets("Rhisiart")
Set wsMarc = Sheets("Marc")
Set wsGrahamIan = Sheets("Graham & Ian")
Set wsAdele = Sheets("Adele")
Set wsEsther = Sheets("Esther")
Set wsJaspal = Sheets("Jaspal")
Set wsMartin = Sheets("Martin")


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


For Each rngCel In rngSource
If rngCel.Value = "Rhisiart" Then
With wsRhisiart
lngDestinRow = .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Row
rngCel.EntireRow.Copy Destination:=wsRhisiart.Cells(lngDestinRow, "A")

End With
End If
Next rngCel


For Each rngCel In rngSource
If rngCel.Value = "Marc" Then
With wsMarc
lngDestinRow = .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Row
rngCel.EntireRow.Copy Destination:=wsMarc.Cells(lngDestinRow, "A")
End With
End If
Next rngCel
End Sub

 

[joelk2]

once ive copied the certain row i want to add the number 1 to the duplicate column.

so the next time i run the macro it doesnt include rows with a number 1 in the duplicate column.

i just cant figure out for the life of me how to add that to my macro.

 

[joelk2]

If in your example you want to above code to get F6 to F8 inclusive I would write it...


Set rngSource = Range("F6:F" & Range("F65536").End(xlUp).Row)

But then I'd have written the whole thing differently. For a start I would have looped through the sheets getting the names and comparing them to the cell values, otherwise you're going to have to modify the macro every time someone leaves/starts.

Thanks, what would that bit do differently to what its doing now?

to be honest this is really my first dabble with VBA. ive got this far by copying bits of code from around the net and modifying them.

the way ive written it works but everytime i re-run the macro it copies all of the rows again which gives me duplicates in the individuals sheets.

 

[joelk2]

You don't actuallly check whether they are already copied (ie. if there is a 1 in the duplicate column).

For Each rngCel In rngSource
If rngCel.Value = "Rhisiart" Then

[B][COLOR="DarkRed"]Put an if test in here to check if the Duplicate field is set to one, and only continue if it isn't.[/COLOR][/B]

With wsRhisiart
lngDestinRow = .Cells(.Rows.Count, "F").End(xlUp).Offset(1, 0).Row
rngCel.EntireRow.Copy Destination:=wsRhisiart.Cells(lngDestinRow, "A")

End With
End If
Next rngCel

i know, this is the bit i want to add to the code but am clueless on how to do it.

would it be better to do an if statement or an autofilter and then the copying bits?

 

[joelk2]

that would be awesome if you could and wouldnt mind.

https://www.dropbox.com/s/zifbkmsvz50jdf6/Copy of Project Lead Database - WEST.xlsm

i think that link should work

 

[joelk2]

Here you go mate, been in meetings all morning so only quick, but simple and does what you want....



You can also add or delete named sheets without having to adjust the macro

Thanks,

It works but doesnt add the "1" to the duplicate column once its copied. any chance you could add that in also?

 

[joelk2]

Oops, knew I'd missed something....

just add the line below

you sir are a legend, thankyou very much.

ive spent the last 3 days trying to do this. more reading required.

 

[joelk2]

*ALSO, there's no error handling in that code so be careful, if you input a name with the wrong spelling or that doesn't have an associated worksheet and error will occur.

That shouldnt happen. i have the name box as a dropdown so they have to manually pick the name or spell it correctly.