Excel Guru's

joelk2 · 15 Apr 2014 at 08:46

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

AndrewNR · 15 Apr 2014 at 08:58

joelk2 said:
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.

I don't understand what you mean here but can't you just use a variable, add 1 to it and use it as the argument to your row/cell destinations?

joelk2 · 15 Apr 2014 at 09:00

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.

estebanrey · 15 Apr 2014 at 09:03

joelk2 said:
Set rngSource = .Range(.Cells(5, "F"), .Cells(.Rows.Count, "F").End(xlUp))

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.

joelk2 · 15 Apr 2014 at 09:07

estebanrey said:
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.

Tuppy_Glossop · 15 Apr 2014 at 09:09

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

Code:

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

joelk2 · 15 Apr 2014 at 09:13

Tuppy_Glossop said:

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

Code:

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?

Tuppy_Glossop · 15 Apr 2014 at 09:16

I would start with an if statement just to get it working.

estebanrey · 15 Apr 2014 at 09:16

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

Nothing, just how I was taught to do it. But I guess with varying versions of Excel now the rows.count method you've included in yours is probably better.

joelk2 said:
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.

I can't see where in your code you are attempting to add the one and check it before you copy. To add a value after copying use..

Range("N6").FormulaR1C1 = "1"

But use your code to get the correct cell to add to, then check it before copying by using a simple IF statement.

estebanrey · 15 Apr 2014 at 09:19

Can you post a link to the spreadsheet? I'll have bash at rewriting it this morning if you like

Tuppy_Glossop · 15 Apr 2014 at 09:20

Eventually you can use autofilters. At that stage you can get the unique values in the Rep column and, for each of them, build an autofilter with column name equal to current Rep and Duplicate not equal to one.

joelk2 · 15 Apr 2014 at 09:22

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

estebanrey · 15 Apr 2014 at 11:29

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

Sub Copy()

Dim RowLoopCount As Integer
Dim CopySheet As String

RowLoopCount = 6

Do

If Sheets("Main").Range("N" & RowLoopCount).FormulaR1C1 <> "1" Then

CopySheet = Sheets("Main").Range("F" & RowLoopCount).FormulaR1C1
Sheets("Main").Range("A" & RowLoopCount).EntireRow.Copy Destination:= _
Sheets(CopySheet).Range("A" & Rows.Count).End(xlUp).Offset(1)

End If

RowLoopCount = RowLoopCount + 1
Loop Until RowLoopCount > Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row

End Sub

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

joelk2 · 15 Apr 2014 at 11:36

estebanrey said:
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?

estebanrey · 15 Apr 2014 at 11:51

joelk2 said:
Thanks,

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

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

just add the line below

Sub Copy()

Dim RowLoopCount As Integer
Dim CopySheet As String

RowLoopCount = 6

Do

If Sheets("Main").Range("N" & RowLoopCount).FormulaR1C1 <> "1" Then

CopySheet = Sheets("Main").Range("F" & RowLoopCount).FormulaR1C1
Sheets("Main").Range("A" & RowLoopCount).EntireRow.Copy Destination:= _
Sheets(CopySheet).Range("A" & Rows.Count).End(xlUp).Offset(1)
Sheets("Main").Range("N" & RowLoopCount).FormulaR1C1 = "1"

End If

RowLoopCount = RowLoopCount + 1
Loop Until RowLoopCount > Sheets("Main").Range("A" & Rows.Count).End(xlUp).Row

End Sub

joelk2 · 15 Apr 2014 at 11:58

estebanrey said:
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.

estebanrey · 15 Apr 2014 at 13:05

joelk2 said:
you sir are a legend, thankyou very much.

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

No probs, as I said it's only a very quick effort to get the job done and will work well with reasonable sized spreadsheets. If you'll be using it to store tens of thousands of records you may want to look into autofilters and the like.

*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.

joelk2 · 15 Apr 2014 at 14:07

estebanrey said:
*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.