This segment of codes lags terribly, and I'm not sure why. When I
Break then Continue the code, it speeds up again. Is there any way I
can tidy up the following code to make it more efficient?

'* Create destination Workbook and move data to it
DestRptCols = Array("Trans Type", "Trans ID", "Event ID",
"Location ID", "Constit ID", _
"Constit Type", "First Name", "Last Name",
"Eng/Fr", "Address Line1", _
"City", "Prov", "Postal Code", "Country",
"Home Email", "Email Y/N", _
"Registration Fee", "Registration Fee
Amount", "Donation Date", _
"Donation Amount", "Tax Receipt Number",
"Tax Receipt Amount", _
"Payment Method", "CC Transaction ID", "CC
Type", "CC Holder Name")

Set DestBk = Workbooks.Add
DestCols = 0
SrcLast = LastRow(SrcWS)

For Each Thing In DestRptCols
SourceBk.Activate
Set MyCell = Cells.Find(Thing, After:=ActiveCell,
LookIn:=xlFormulas, _
Lookat:=xlPart,
SearchOrder:=xlByRows, _
SearchDirection:=xlNext,
MatchCase:=False).Columns
Range(MyCell.Address & ":" & MyCell.Offset(SrcLast,
0).Address).Copy

DestCols = DestCols + 1

With DestBk.Sheets(1).Columns(DestCols)
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Next

Hello:

I resolved it by limiting the range of cells that the Find was
operating in. Rather than anywhere in the worksheet (which I didn't
really want) I restricted it to search only in the header row.

Set MyCell = headerrow.Find(.....


Steven

On Aug 7, 12:33*pm, wrote:
This segment of codes lags terribly, and I'm not sure why. When I
Break then Continue the code, it speeds up again. Is there any way I
can tidy up the following code to make it more efficient?

'* Create destination Workbook and move data to it
* * * * DestRptCols = Array("Trans Type", "Trans ID", "Event ID",
"Location ID", "Constit ID", _
* * * * * * * * * * * * * * "Constit Type", "First Name", "Last Name",
"Eng/Fr", "Address Line1", _
* * * * * * * * * * * * * * "City", "Prov", "Postal Code", "Country",
"Home Email", "Email Y/N", _
* * * * * * * * * * * * * * "Registration Fee", "Registration Fee
Amount", "Donation Date", _
* * * * * * * * * * * * * * "Donation Amount", "Tax Receipt Number",
"Tax Receipt Amount", _
* * * * * * * * * * * * * * "Payment Method", "CC Transaction ID", "CC
Type", "CC Holder Name")

* * * * Set DestBk = Workbooks.Add
* * * * DestCols = 0
* * * * SrcLast = LastRow(SrcWS)

* * * * For Each Thing In DestRptCols
* * * * * * SourceBk.Activate
* * * * * * * * Set MyCell = Cells.Find(Thing, After:=ActiveCell,
LookIn:=xlFormulas, _
* * * * * * * * * * * * * * * * * Lookat:=xlPart,
SearchOrder:=xlByRows, _
* * * * * * * * * * * * * * * * * SearchDirection:=xlNext,
MatchCase:=False).Columns
* * * * * * * * Range(MyCell.Address & ":" & MyCell.Offset(SrcLast,
0).Address).Copy

* * * * * * * * DestCols = DestCols + 1

* * * * * * With DestBk.Sheets(1).Columns(DestCols)
* * * * * * * * * * * * .PasteSpecial Paste:=8
* * * * * * * * * * * * .PasteSpecial xlPasteValues
* * * * * * * * * * * * .PasteSpecial xlPasteFormats
* * * * * * End With

* * * * Next

If you are search ing for the headers in a row try this instead. I'm no
tsure why you need every cell on the worksheet or the After.

from
Set MyCell = Cells.Find(Thing, After:=ActiveCell, LookIn:=xlFormulas, _
Lookat:=xlPart, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False).Columns

to
Set MyCell = Row(1).Find(Thing, _
LookIn:=xlFormulas, _
Lookat:=xlPart, _
MatchCase:=False)
Set MyColumn = Columns(Mycell.column)



" wrote:

This segment of codes lags terribly, and I'm not sure why. When I
Break then Continue the code, it speeds up again. Is there any way I
can tidy up the following code to make it more efficient?

'* Create destination Workbook and move data to it
DestRptCols = Array("Trans Type", "Trans ID", "Event ID",
"Location ID", "Constit ID", _
"Constit Type", "First Name", "Last Name",
"Eng/Fr", "Address Line1", _
"City", "Prov", "Postal Code", "Country",
"Home Email", "Email Y/N", _
"Registration Fee", "Registration Fee
Amount", "Donation Date", _
"Donation Amount", "Tax Receipt Number",
"Tax Receipt Amount", _
"Payment Method", "CC Transaction ID", "CC
Type", "CC Holder Name")

Set DestBk = Workbooks.Add
DestCols = 0
SrcLast = LastRow(SrcWS)

For Each Thing In DestRptCols
SourceBk.Activate
Set MyCell = Cells.Find(Thing, After:=ActiveCell,
LookIn:=xlFormulas, _
Lookat:=xlPart,
SearchOrder:=xlByRows, _
SearchDirection:=xlNext,
MatchCase:=False).Columns
Range(MyCell.Address & ":" & MyCell.Offset(SrcLast,
0).Address).Copy

DestCols = DestCols + 1

With DestBk.Sheets(1).Columns(DestCols)
.PasteSpecial Paste:=8
.PasteSpecial xlPasteValues
.PasteSpecial xlPasteFormats
End With

Next

Joel:

Thank you, that is similar to the solution I came up with, but
simplifies it further. I'll fit this in and update my code.



S

On Aug 7, 2:39*pm, Joel wrote:
If you are search ing for the headers in a row try this instead. *I'm no
tsure why you need every cell on the worksheet or the After.

from
Set MyCell = Cells.Find(Thing, After:=ActiveCell, LookIn:=xlFormulas, _
* * * * * * * * * * * * * * * * * Lookat:=xlPart, SearchOrder:=xlByRows, _
* * * * * * * * * * * * * * * * * SearchDirection:=xlNext, _
* * * * * * * * * * * * * * * * *MatchCase:=False).Columns

to
Set MyCell = Row(1).Find(Thing, _
* * * * * * * * * LookIn:=xlFormulas, _
* * * * * * * * * Lookat:=xlPart, _
* * * * * * * * * MatchCase:=False)
Set MyColumn = Columns(Mycell.column)

" wrote:
This segment of codes lags terribly, and I'm not sure why. When I
Break then Continue the code, it speeds up again. Is there any way I
can tidy up the following code to make it more efficient?

'* Create destination Workbook and move data to it
* * * * DestRptCols = Array("Trans Type", "Trans ID", "Event ID",
"Location ID", "Constit ID", _
* * * * * * * * * * * * * * "Constit Type", "First Name", "Last Name",
"Eng/Fr", "Address Line1", _
* * * * * * * * * * * * * * "City", "Prov", "Postal Code", "Country",
"Home Email", "Email Y/N", _
* * * * * * * * * * * * * * "Registration Fee", "Registration Fee
Amount", "Donation Date", _
* * * * * * * * * * * * * * "Donation Amount", "Tax Receipt Number",
"Tax Receipt Amount", _
* * * * * * * * * * * * * * "Payment Method", "CC Transaction ID", "CC
Type", "CC Holder Name")

* * * * Set DestBk = Workbooks.Add
* * * * DestCols = 0
* * * * SrcLast = LastRow(SrcWS)

* * * * For Each Thing In DestRptCols
* * * * * * SourceBk.Activate
* * * * * * * * Set MyCell = Cells.Find(Thing, After:=ActiveCell,
LookIn:=xlFormulas, _
* * * * * * * * * * * * * * * * * Lookat:=xlPart,
SearchOrder:=xlByRows, _
* * * * * * * * * * * * * * * * * SearchDirection:=xlNext,
MatchCase:=False).Columns
* * * * * * * * Range(MyCell.Address & ":" & MyCell.Offset(SrcLast,
0).Address).Copy

* * * * * * * * DestCols = DestCols + 1

* * * * * * With DestBk.Sheets(1).Columns(DestCols)
* * * * * * * * * * * * .PasteSpecial Paste:=8
* * * * * * * * * * * * .PasteSpecial xlPasteValues
* * * * * * * * * * * * .PasteSpecial xlPasteFormats
* * * * * * End With

* * * * Next