Stuart

sorry, I can't follow your code. That said, can you not just test each of
the three conditions and set a variable, say CopyFlag. Then, if the
CopyFlag is set, copy the record set.

In pseudo code:

Dim CopyFlag As Boolean
CopyFlag = False
If "Condition 1" is True Then CopyFlag = True
If "Condition 2" is True Then CopyFlag = True
If "Condition 3" is True Then CopyFlag = True
If CopyFlag Then "copy recordset

Thought you'd solved this problem once?

Regards

Trevor


"Stuart" wrote in message
...
Sample data to be copied:

X Data............. 5 no 25 125 T Y D
more data
more etc

Data is in a single row (wraptext is enabled) and occupies
cols A:F.
T, Y and D are in cols G:I and are user's 'tags', indicating
to which sheet (in a different book) the recordset is to be
copied.

Here's the problem, as faithfully as I am able to explain it:

In general if only T were present, then I'd get one paste
into sheet(T). If T and Y are present, then I'm getting
2 records pasting into both sheets T and Y. etc.
This is not 100% consistent, however, but indicative,
nevertheless.

Here is the Copy/Paste sequence:

For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select 'for now
.Unprotect
LastRow = Application.Max(.Cells(Rows.Count, £Col + 2) _
.End(xlUp).Row, .Cells(Rows.Count, £Col + 3) _
.End(xlUp).Row, _
.Cells(Rows.Count, £Col + 4).End(xlUp).Row)
If LastRow 1 Then
Set DataRange = .Range(.Cells(2, £Col + 2), _
.Cells(LastRow, £Col + 4))
For Each Cell In DataRange.SpecialCells(xlConstants)
If Not IsEmpty(Cell) Then
If .Range("A" & Cell.Row).End(xlUp).Value = "Item" Then
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0,
1).End(xlDown).Row
Else
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).End(xlDown).Row
End If

'For normal BofQ's use
EndCopyRow = Cell.Row

.Range("A" & StartCopyRow, .Cells(EndCopyRow, _
£Col + 4)).Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls") .Worksheets _
(Cell.Value).Cells(Rows.Count, 3).End(xlUp) _
.Offset(2, -1)
If Not IsEmpty(.Cells(StartCopyRow, £Col).End +
(xlDown).Offset(-1, 1 - £Col)) Then
.Cells(StartCopyRow, £Col).End(xlDown).Offset _
(-1, 1 - £Col) .Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls").Worksheets _
(Cell.Value).Range("B65536").End(xlUp).Offset(0, -1)
End If
End If
Next
End If
End With
End If
Next

I've tried everything I can think of over the last few days, including
a column by column copy and paste, copying and pasting just one
tag value at a time, etc....to no avail.....basically very similar
duplicate copies occur.

If the problem is not apparent, then I have a small workbook with
code, if anyone would be prepared to accept an attachment.

It's holding up some serious work, hence my repost and the time
I'm spending on it, so help would be most welcome.

Regards.



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003

Will try your suggestion. Many thanks.

As to the code:

£Col is 5, 6 or 14 depending on the type of workbook,
and is used to define the 'tag' columns.
LastRow finds the last value in the 'tag' columns.
DataRange is the range defined by the first and last
value in the 'tag' columns.
Cell is found in the 'tag' columns, and the recordset
is defined from that, then it is copied to the target
workbook, into the sheet named "Cell".

Sample data to be copied:

X Data............. 5 no 25 125 T Y D
more data
more etc

Data is in a single row (wraptext is enabled) and occupies
cols A:F.
T, Y and D are in cols G:I and are user's 'tags', indicating
to which sheet (in a different book) the recordset is to be
copied.

Here's the problem, as faithfully as I am able to explain it:

In general if only T were present, then I'd get one paste
into sheet(T). If T and Y are present, then I'm getting
2 records pasting into both sheets T and Y. etc.
This is not 100% consistent, however, but indicative,
nevertheless.

Here is the Copy/Paste sequence:

For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select 'for now
.Unprotect
LastRow = Application.Max(.Cells(Rows.Count, £Col + 2) _
.End(xlUp).Row, .Cells(Rows.Count, £Col + 3) _
.End(xlUp).Row, _
.Cells(Rows.Count, £Col + 4).End(xlUp).Row)
If LastRow 1 Then
Set DataRange = .Range(.Cells(2, £Col + 2), _
.Cells(LastRow, £Col + 4))
For Each Cell In DataRange.SpecialCells(xlConstants)
If Not IsEmpty(Cell) Then
If .Range("A" & Cell.Row).End(xlUp).Value = "Item" Then
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).Row
Else
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).End(xlDown).Row
End If

'For normal BofQ's use
EndCopyRow = Cell.Row

.Range("A" & StartCopyRow, .Cells(EndCopyRow, _
£Col + 4)).Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls") .Worksheets _
(Cell.Value).Cells(Rows.Count, 3).End(xlUp) _
.Offset(2, -1)
If Not IsEmpty(.Cells(StartCopyRow, £Col).End +
(xlDown).Offset(-1, 1 - £Col)) Then
.Cells(StartCopyRow, £Col).End(xlDown).Offset _
(-1, 1 - £Col) .Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls").Worksheets _
(Cell.Value).Range("B65536").End(xlUp).Offset(0, -1)
End If
End If
Next
End If
End With
End If
Next

I've tried everything I can think of over the last few days, including
a column by column copy and paste, copying and pasting just one
tag value at a time, etc....to no avail.....basically very similar
duplicate copies occur.

If the problem is not apparent, then I have a small workbook with
code, if anyone would be prepared to accept an attachment.

It's holding up some serious work, hence my repost and the time
I'm spending on it, so help would be most welcome.

Regards.



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003





---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003

Put in some debug.print statements or msgbox statements around your copy
statements that reveal what the value of Cell is
(cell.Address(external:=True) and so forth so you can see when the data is
being copied.

Sure you don't have duplicate worksheets that are hidden?

--
Regards,
Tom Ogilvy


Stuart wrote in message
...
Will try your suggestion. Many thanks.

As to the code:

£Col is 5, 6 or 14 depending on the type of workbook,
and is used to define the 'tag' columns.
LastRow finds the last value in the 'tag' columns.
DataRange is the range defined by the first and last
value in the 'tag' columns.
Cell is found in the 'tag' columns, and the recordset
is defined from that, then it is copied to the target
workbook, into the sheet named "Cell".

Sample data to be copied:

X Data............. 5 no 25 125 T Y D
more data
more etc

Data is in a single row (wraptext is enabled) and occupies
cols A:F.
T, Y and D are in cols G:I and are user's 'tags', indicating
to which sheet (in a different book) the recordset is to be
copied.

Here's the problem, as faithfully as I am able to explain it:

In general if only T were present, then I'd get one paste
into sheet(T). If T and Y are present, then I'm getting
2 records pasting into both sheets T and Y. etc.
This is not 100% consistent, however, but indicative,
nevertheless.

Here is the Copy/Paste sequence:

For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select 'for now
.Unprotect
LastRow = Application.Max(.Cells(Rows.Count, £Col + 2) _
.End(xlUp).Row, .Cells(Rows.Count, £Col + 3) _
.End(xlUp).Row, _
.Cells(Rows.Count, £Col + 4).End(xlUp).Row)
If LastRow 1 Then
Set DataRange = .Range(.Cells(2, £Col + 2), _
.Cells(LastRow, £Col + 4))
For Each Cell In DataRange.SpecialCells(xlConstants)
If Not IsEmpty(Cell) Then
If .Range("A" & Cell.Row).End(xlUp).Value = "Item" Then
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).Row
Else
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).End(xlDown).Row
End If

'For normal BofQ's use
EndCopyRow = Cell.Row

.Range("A" & StartCopyRow, .Cells(EndCopyRow, _
£Col + 4)).Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls") .Worksheets _
(Cell.Value).Cells(Rows.Count, 3).End(xlUp) _
.Offset(2, -1)
If Not IsEmpty(.Cells(StartCopyRow, £Col).End +
(xlDown).Offset(-1, 1 - £Col)) Then
.Cells(StartCopyRow, £Col).End(xlDown).Offset _
(-1, 1 - £Col) .Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls").Worksheets _
(Cell.Value).Range("B65536").End(xlUp).Offset(0, -1)
End If
End If
Next
End If
End With
End If
Next

I've tried everything I can think of over the last few days, including
a column by column copy and paste, copying and pasting just one
tag value at a time, etc....to no avail.....basically very similar
duplicate copies occur.

If the problem is not apparent, then I have a small workbook with
code, if anyone would be prepared to accept an attachment.

It's holding up some serious work, hence my repost and the time
I'm spending on it, so help would be most welcome.

Regards.



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003





---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003

Managed an hour ago, to get it working, but had to alter
the way the copy routine operated, as follows:

Instead of sampling down the range and then reacting to
whatever the 'tag' value was, I made the code look for
each specific 'tag' value in turn.

All I did was to 'wrap' the copy routine with
For Each itm In frmName_Contractors.lbDataCode.List
and then continue with:
For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then etc

inefficient but seems to work Will be a problem with large
amounts of data, though.

Regards.

"Tom Ogilvy" wrote in message
...
Put in some debug.print statements or msgbox statements around your copy
statements that reveal what the value of Cell is
(cell.Address(external:=True) and so forth so you can see when the data
is
being copied.

Sure you don't have duplicate worksheets that are hidden?

--
Regards,
Tom Ogilvy


Stuart wrote in message
...
Will try your suggestion. Many thanks.

As to the code:

£Col is 5, 6 or 14 depending on the type of workbook,
and is used to define the 'tag' columns.
LastRow finds the last value in the 'tag' columns.
DataRange is the range defined by the first and last
value in the 'tag' columns.
Cell is found in the 'tag' columns, and the recordset
is defined from that, then it is copied to the target
workbook, into the sheet named "Cell".

Sample data to be copied:

X Data............. 5 no 25 125 T Y D
more data
more etc

Data is in a single row (wraptext is enabled) and occupies
cols A:F.
T, Y and D are in cols G:I and are user's 'tags', indicating
to which sheet (in a different book) the recordset is to be
copied.

Here's the problem, as faithfully as I am able to explain it:

In general if only T were present, then I'd get one paste
into sheet(T). If T and Y are present, then I'm getting
2 records pasting into both sheets T and Y. etc.
This is not 100% consistent, however, but indicative,
nevertheless.

Here is the Copy/Paste sequence:

For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select 'for now
.Unprotect
LastRow = Application.Max(.Cells(Rows.Count, £Col + 2) _
.End(xlUp).Row, .Cells(Rows.Count, £Col + 3) _
.End(xlUp).Row, _
.Cells(Rows.Count, £Col + 4).End(xlUp).Row)
If LastRow 1 Then
Set DataRange = .Range(.Cells(2, £Col + 2), _
.Cells(LastRow, £Col + 4))
For Each Cell In DataRange.SpecialCells(xlConstants)
If Not IsEmpty(Cell) Then
If .Range("A" & Cell.Row).End(xlUp).Value = "Item" Then
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).Row
Else
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).End(xlDown).Row
End If

'For normal BofQ's use
EndCopyRow = Cell.Row

.Range("A" & StartCopyRow, .Cells(EndCopyRow, _
£Col + 4)).Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls") .Worksheets _
(Cell.Value).Cells(Rows.Count, 3).End(xlUp) _
.Offset(2, -1)
If Not IsEmpty(.Cells(StartCopyRow, £Col).End +
(xlDown).Offset(-1, 1 - £Col)) Then
.Cells(StartCopyRow, £Col).End(xlDown).Offset _
(-1, 1 - £Col) .Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls").Worksheets _
(Cell.Value).Range("B65536").End(xlUp).Offset(0, -1)
End If
End If
Next
End If
End With
End If
Next

I've tried everything I can think of over the last few days, including
a column by column copy and paste, copying and pasting just one
tag value at a time, etc....to no avail.....basically very similar
duplicate copies occur.

If the problem is not apparent, then I have a small workbook with
code, if anyone would be prepared to accept an attachment.

It's holding up some serious work, hence my repost and the time
I'm spending on it, so help would be most welcome.

Regards.



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003





---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003

I spoke too soon.

This was the start of the 'wrapped' routine that I
believe copied correctly:

For Each itm In frmName_Contractors.lbDataCode.List
For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select
.Unprotect

Am almost certain that it ran without an error being thrown.
However subsequent runs give:
Method 'Select' of Object '_Worksheet' failed
against .Select

If I rem this, then the multiple copies appear again!

Regards.

"Tom Ogilvy" wrote in message
...
Put in some debug.print statements or msgbox statements around your copy
statements that reveal what the value of Cell is
(cell.Address(external:=True) and so forth so you can see when the data
is
being copied.

Sure you don't have duplicate worksheets that are hidden?

--
Regards,
Tom Ogilvy


Stuart wrote in message
...
Will try your suggestion. Many thanks.

As to the code:

£Col is 5, 6 or 14 depending on the type of workbook,
and is used to define the 'tag' columns.
LastRow finds the last value in the 'tag' columns.
DataRange is the range defined by the first and last
value in the 'tag' columns.
Cell is found in the 'tag' columns, and the recordset
is defined from that, then it is copied to the target
workbook, into the sheet named "Cell".

Sample data to be copied:

X Data............. 5 no 25 125 T Y D
more data
more etc

Data is in a single row (wraptext is enabled) and occupies
cols A:F.
T, Y and D are in cols G:I and are user's 'tags', indicating
to which sheet (in a different book) the recordset is to be
copied.

Here's the problem, as faithfully as I am able to explain it:

In general if only T were present, then I'd get one paste
into sheet(T). If T and Y are present, then I'm getting
2 records pasting into both sheets T and Y. etc.
This is not 100% consistent, however, but indicative,
nevertheless.

Here is the Copy/Paste sequence:

For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select 'for now
.Unprotect
LastRow = Application.Max(.Cells(Rows.Count, £Col + 2) _
.End(xlUp).Row, .Cells(Rows.Count, £Col + 3) _
.End(xlUp).Row, _
.Cells(Rows.Count, £Col + 4).End(xlUp).Row)
If LastRow 1 Then
Set DataRange = .Range(.Cells(2, £Col + 2), _
.Cells(LastRow, £Col + 4))
For Each Cell In DataRange.SpecialCells(xlConstants)
If Not IsEmpty(Cell) Then
If .Range("A" & Cell.Row).End(xlUp).Value = "Item" Then
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).Row
Else
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).End(xlDown).Row
End If

'For normal BofQ's use
EndCopyRow = Cell.Row

.Range("A" & StartCopyRow, .Cells(EndCopyRow, _
£Col + 4)).Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls") .Worksheets _
(Cell.Value).Cells(Rows.Count, 3).End(xlUp) _
.Offset(2, -1)
If Not IsEmpty(.Cells(StartCopyRow, £Col).End +
(xlDown).Offset(-1, 1 - £Col)) Then
.Cells(StartCopyRow, £Col).End(xlDown).Offset _
(-1, 1 - £Col) .Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls").Worksheets _
(Cell.Value).Range("B65536").End(xlUp).Offset(0, -1)
End If
End If
Next
End If
End With
End If
Next

I've tried everything I can think of over the last few days, including
a column by column copy and paste, copying and pasting just one
tag value at a time, etc....to no avail.....basically very similar
duplicate copies occur.

If the problem is not apparent, then I have a small workbook with
code, if anyone would be prepared to accept an attachment.

It's holding up some serious work, hence my repost and the time
I'm spending on it, so help would be most welcome.

Regards.



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003





---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003

Rather than blindly try to develop workarounds for a problem you haven't
even identified the cause for, put in the debugging statements and invest
the time to find where you are getting multiple copies.

--
Regards,
Tom Ogilvy


Stuart wrote in message
...
I spoke too soon.

This was the start of the 'wrapped' routine that I
believe copied correctly:

For Each itm In frmName_Contractors.lbDataCode.List
For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select
.Unprotect

Am almost certain that it ran without an error being thrown.
However subsequent runs give:
Method 'Select' of Object '_Worksheet' failed
against .Select

If I rem this, then the multiple copies appear again!

Regards.

"Tom Ogilvy" wrote in message
...
Put in some debug.print statements or msgbox statements around your copy
statements that reveal what the value of Cell is
(cell.Address(external:=True) and so forth so you can see when the data
is
being copied.

Sure you don't have duplicate worksheets that are hidden?

--
Regards,
Tom Ogilvy


Stuart wrote in message
...
Will try your suggestion. Many thanks.

As to the code:

£Col is 5, 6 or 14 depending on the type of workbook,
and is used to define the 'tag' columns.
LastRow finds the last value in the 'tag' columns.
DataRange is the range defined by the first and last
value in the 'tag' columns.
Cell is found in the 'tag' columns, and the recordset
is defined from that, then it is copied to the target
workbook, into the sheet named "Cell".

Sample data to be copied:

X Data............. 5 no 25 125 T Y D
more data
more etc

Data is in a single row (wraptext is enabled) and occupies
cols A:F.
T, Y and D are in cols G:I and are user's 'tags', indicating
to which sheet (in a different book) the recordset is to be
copied.

Here's the problem, as faithfully as I am able to explain it:

In general if only T were present, then I'd get one paste
into sheet(T). If T and Y are present, then I'm getting
2 records pasting into both sheets T and Y. etc.
This is not 100% consistent, however, but indicative,
nevertheless.

Here is the Copy/Paste sequence:

For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select 'for now
.Unprotect
LastRow = Application.Max(.Cells(Rows.Count, £Col + 2) _
.End(xlUp).Row, .Cells(Rows.Count, £Col + 3) _
.End(xlUp).Row, _
.Cells(Rows.Count, £Col + 4).End(xlUp).Row)
If LastRow 1 Then
Set DataRange = .Range(.Cells(2, £Col + 2), _
.Cells(LastRow, £Col + 4))
For Each Cell In DataRange.SpecialCells(xlConstants)
If Not IsEmpty(Cell) Then
If .Range("A" & Cell.Row).End(xlUp).Value = "Item" Then
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).Row
Else
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).End(xlDown).Row
End If

'For normal BofQ's use
EndCopyRow = Cell.Row

.Range("A" & StartCopyRow, .Cells(EndCopyRow, _
£Col + 4)).Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls") .Worksheets _
(Cell.Value).Cells(Rows.Count, 3).End(xlUp) _
.Offset(2, -1)
If Not IsEmpty(.Cells(StartCopyRow, £Col).End +
(xlDown).Offset(-1, 1 - £Col)) Then
.Cells(StartCopyRow, £Col).End(xlDown).Offset _
(-1, 1 - £Col) .Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls").Worksheets _

(Cell.Value).Range("B65536").End(xlUp).Offset(0, -1)
End If
End If
Next
End If
End With
End If
Next

I've tried everything I can think of over the last few days,
including
a column by column copy and paste, copying and pasting just one
tag value at a time, etc....to no avail.....basically very similar
duplicate copies occur.

If the problem is not apparent, then I have a small workbook with
code, if anyone would be prepared to accept an attachment.

It's holding up some serious work, hence my repost and the time
I'm spending on it, so help would be most welcome.

Regards.



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003





---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003

Will do,
Regards.

"Tom Ogilvy" wrote in message
...
Rather than blindly try to develop workarounds for a problem you haven't
even identified the cause for, put in the debugging statements and invest
the time to find where you are getting multiple copies.

--
Regards,
Tom Ogilvy


Stuart wrote in message
...
I spoke too soon.

This was the start of the 'wrapped' routine that I
believe copied correctly:

For Each itm In frmName_Contractors.lbDataCode.List
For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select
.Unprotect

Am almost certain that it ran without an error being thrown.
However subsequent runs give:
Method 'Select' of Object '_Worksheet' failed
against .Select

If I rem this, then the multiple copies appear again!

Regards.

"Tom Ogilvy" wrote in message
...
Put in some debug.print statements or msgbox statements around your
copy
statements that reveal what the value of Cell is
(cell.Address(external:=True) and so forth so you can see when the
data
is
being copied.

Sure you don't have duplicate worksheets that are hidden?

--
Regards,
Tom Ogilvy


Stuart wrote in message
...
Will try your suggestion. Many thanks.

As to the code:

£Col is 5, 6 or 14 depending on the type of workbook,
and is used to define the 'tag' columns.
LastRow finds the last value in the 'tag' columns.
DataRange is the range defined by the first and last
value in the 'tag' columns.
Cell is found in the 'tag' columns, and the recordset
is defined from that, then it is copied to the target
workbook, into the sheet named "Cell".

Sample data to be copied:

X Data............. 5 no 25 125 T Y D
more data
more etc

Data is in a single row (wraptext is enabled) and occupies
cols A:F.
T, Y and D are in cols G:I and are user's 'tags', indicating
to which sheet (in a different book) the recordset is to be
copied.

Here's the problem, as faithfully as I am able to explain it:

In general if only T were present, then I'd get one paste
into sheet(T). If T and Y are present, then I'm getting
2 records pasting into both sheets T and Y. etc.
This is not 100% consistent, however, but indicative,
nevertheless.

Here is the Copy/Paste sequence:

For Each ws In Workbooks(wkbkname).Worksheets
If Not ws.Name = "DataStore" Then
wsCtr = wsCtr + 1
With ws
.Select 'for now
.Unprotect
LastRow = Application.Max(.Cells(Rows.Count, £Col + 2) _
.End(xlUp).Row, .Cells(Rows.Count, £Col + 3) _
.End(xlUp).Row, _
.Cells(Rows.Count, £Col + 4).End(xlUp).Row)
If LastRow 1 Then
Set DataRange = .Range(.Cells(2, £Col + 2), _
.Cells(LastRow, £Col + 4))
For Each Cell In DataRange.SpecialCells(xlConstants)
If Not IsEmpty(Cell) Then
If .Range("A" & Cell.Row).End(xlUp).Value = "Item" Then
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).Row
Else
StartCopyRow = .Range("A" & Cell.Row).End(xlUp) _
.Offset(0, 1).End(xlDown).End(xlDown).Row
End If

'For normal BofQ's use
EndCopyRow = Cell.Row

.Range("A" & StartCopyRow, .Cells(EndCopyRow, _
£Col + 4)).Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls") .Worksheets _
(Cell.Value).Cells(Rows.Count, 3).End(xlUp) _
.Offset(2, -1)
If Not IsEmpty(.Cells(StartCopyRow, £Col).End +
(xlDown).Offset(-1, 1 - £Col)) Then
.Cells(StartCopyRow, £Col).End(xlDown).Offset _
(-1, 1 - £Col) .Copy Destination:=Workbooks _
("Sorted_Tagged " & x(4) & ".xls").Worksheets _

(Cell.Value).Range("B65536").End(xlUp).Offset(0, -1)
End If
End If
Next
End If
End With
End If
Next

I've tried everything I can think of over the last few days,
including
a column by column copy and paste, copying and pasting just one
tag value at a time, etc....to no avail.....basically very similar
duplicate copies occur.

If the problem is not apparent, then I have a small workbook with
code, if anyone would be prepared to accept an attachment.

It's holding up some serious work, hence my repost and the time
I'm spending on it, so help would be most welcome.

Regards.



---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003





---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003






---
Outgoing mail is certified Virus Free.
Checked by AVG anti-virus system (http://www.grisoft.com).
Version: 6.0.518 / Virus Database: 316 - Release Date: 11/09/2003