Solved: use array to speed up copy and paste

I am trying to speed up a copy and paste process.
currently my sub scans column A for the letter "a"
if present the sub copies some of the values in the row to another sheet.
Would the process go faster if I load the used cells to an array,
and use coordinates to transfer the data? still scanning for the "a" in the first column...

I usually only use 20 rows or so down nd the columns are always 50 accross. I use a worksheet_change and selection change sub on this data, and I think my sub to copy data might be slowing down from selection change. If I can disable a worksheet sub and re-eneable after the transfer is complete may help (don't know how to do this)

this is the sub to transfer the data. Each entry transfer takes over a minute. Screen at bottom says calculating repeatedly...
not sure what is being calculated either?

[VBA]For Each Cell In sh_source.Range("C3:C" & _
sh_source.Range("C" & Rows.Count).End(xlUp).Row)
If Cell.Offset(, -2).Value = "a" Then
With sh_source
.Range("C" & Cell.Row).Copy
sh_dest.Range("C" & sh_dest.Range("C" & Rows.Count).End(xlUp).Row + 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("J" & Cell.Row).Copy sh_dest.Range("B" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AU" & Cell.Row).Copy
sh_dest.Range("D" & sh_dest.Range("C" & Rows.Count).End(xlUp).Row).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
.Range("O" & Cell.Row).Copy sh_dest.Range("E" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("E" & Cell.Row).Copy sh_dest.Range("F" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("P" & Cell.Row).Copy sh_dest.Range("G" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("Q" & Cell.Row).Copy sh_dest.Range("H" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("R" & Cell.Row).Copy sh_dest.Range("I" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("S" & Cell.Row).Copy sh_dest.Range("J" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("T" & Cell.Row).Copy sh_dest.Range("K" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("U" & Cell.Row).Copy sh_dest.Range("L" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("V" & Cell.Row).Copy sh_dest.Range("M" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("W" & Cell.Row).Copy sh_dest.Range("N" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("X" & Cell.Row).Copy sh_dest.Range("O" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("Y" & Cell.Row).Copy sh_dest.Range("P" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("Z" & Cell.Row).Copy sh_dest.Range("Q" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AA" & Cell.Row).Copy sh_dest.Range("R" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AB" & Cell.Row).Copy sh_dest.Range("S" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AC" & Cell.Row).Copy sh_dest.Range("T" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AD" & Cell.Row).Copy sh_dest.Range("U" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AE" & Cell.Row).Copy sh_dest.Range("V" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AF" & Cell.Row).Copy sh_dest.Range("W" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AG" & Cell.Row).Copy sh_dest.Range("X" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AH" & Cell.Row).Copy sh_dest.Range("Y" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AI" & Cell.Row).Copy sh_dest.Range("Z" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AJ" & Cell.Row).Copy sh_dest.Range("AA" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AK" & Cell.Row).Copy sh_dest.Range("AB" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AL" & Cell.Row).Copy sh_dest.Range("AC" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AM" & Cell.Row).Copy sh_dest.Range("AD" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AN" & Cell.Row).Copy sh_dest.Range("AE" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AO" & Cell.Row).Copy sh_dest.Range("AF" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AP" & Cell.Row).Copy sh_dest.Range("AG" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AQ" & Cell.Row).Copy sh_dest.Range("AH" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AR" & Cell.Row).Copy sh_dest.Range("AI" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AS" & Cell.Row).Copy sh_dest.Range("AJ" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
.Range("AT" & Cell.Row).Copy sh_dest.Range("AK" _
& sh_dest.Range("C" & Rows.Count).End(xlUp).Row)
End With
End If
Next Cell[/VBA]

I was thinking something like this
[VBA]
sub arrayCopy()
Dim arrayData() as array ' is this right?
dim i as long
dim lastRowD as long
dim lastRowQ as long
dim trgtSht as worksheet

set trgtSht = workheets("QCDetail")
set lastRowQ = trgtSht.range("B" & Rows.Count).End
set lastRow = worksheets("Data").range("C" & Rows.Count).End(xlUp).Row)
redim arrayData(1 to 50) ' as 50 columns accross?
for i = 3 to lastRowD ' data starts in 3rd row down
if i.offset(0, -3) = "a" then ' check column A for "a"
arrayData(10, i).value = trgtSht.range("B" & lastRowQ) 'first value copy to QCDetail
' duplicate process to accomidate each copy item
end if
next i
end sub
[/VBA]
not tested, but am I on the right track?
Would this speed up the above code or is there another way to pick the source data and target location that works more quickly?

I though about formating the data to have the same column locations on both pages. The problem is I use all of the data to print a form and make an archive copy of the form as an added worksheet.
The QCDetail sheet only uses some of the data.
I do have a copy of the full data and a sheet called "Raw"
I could use match and index to make the other forms, or 2 sheets for data.
1 to setup for archive and print, and the other for QCDetail.
My goal is to speed up the process...
I already uploaded the file in a different thread, I'll link it here.
Mark

the array would use these entries in a wierd order for the first few,
then from 16 to 46 is sequential

Code:

---

column 10 copies to 2
column 3 copies to 3,
 47 to 4,
 15 to 5,
 5 to 6,
16 to 7,
17 to 8,
etc...
46 to 37 'last value

---

could I call the whole row in one line:
[vba]
with arrayData(10,3,47,15,5,16, ....., 46)[/vba]
calling the column values and use a variable for the row placeholder
through each pass of the rows found with "a" in column A?
If the arrayData() counts for just column values in one row.
Or can I store row and column in the array and call the columns explicitly and the rows variably (is that a word?) using a variable...

I have this to remove several columns at a time, can i translate to copying...
[VBA]Range("A:A,D:E,G:G,H:H,J:J,O:O,T:AR,AT:BA,BC:IV").EntireColumn.Delete[/VBA]

See if this is quicker

[vba]

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With
NextRow = sh_dest.Range("C" & Rows.Count).End(xlUp).Row
For Each cell In sh_source.Range("C3:C" & NextRow)
If cell.Offset(, -2).Value = "a" Then
With sh_source
.Range("C" & cell.Row).Copy
sh_dest.Range("C" & NextRow + 1).PasteSpecial Paste:=xlPasteValues
.Range("J" & cell.Row).Copy sh_dest.Range("B" & NextRow)
.Range("AU" & cell.Row).Copy
sh_dest.Range("D" & NextRow).PasteSpecial Paste:=xlPasteValues
.Range("O" & cell.Row).Copy sh_dest.Range("E" & NextRow)
.Range("E" & cell.Row).Copy sh_dest.Range("F" & NextRow)
.Range("P" & cell.Row).Resize(, 31).Copy sh_dest.Range("G" & NextRow)
End With
End If
Next cell
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
[/vba]

Thank You xld!
At first your code was copying everything to one line.
I had that same problem early in development so found a slight modification.
The lastrow is different from the source and the destination...

But man is that fast.
You don't know how many lives you just touched.
I feel all giddy.
Mark

modified solution... note the tribute in the sub name...
[VBA]
Sub AddToDetail_xld()
Dim sh_source As Worksheet
Dim sh_dest As Worksheet
Dim Cell As Range

Set sh_source = Worksheets("Data")
Set sh_dest = Worksheets("QCDetail")

With Application
.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Call remove_borders

nextRowD = sh_dest.Range("C" & Rows.Count).End(xlUp).Row
NextRowS = sh_source.Range("C" & Rows.Count).End(xlUp).Row
For Each Cell In sh_source.Range("C3:C" & NextRowS)
If Cell.Offset(, -2).Value = "a" Then
nextRowD = nextRowD + 1
With sh_source
.Range("C" & Cell.Row).Copy
sh_dest.Range("C" & nextRowD).PasteSpecial Paste:=xlPasteValues
.Range("J" & Cell.Row).Copy sh_dest.Range("B" & nextRowD)
.Range("AU" & Cell.Row).Copy
sh_dest.Range("D" & nextRowD).PasteSpecial Paste:=xlPasteValues
.Range("O" & Cell.Row).Copy sh_dest.Range("E" & nextRowD)
.Range("E" & Cell.Row).Copy sh_dest.Range("F" & nextRowD)
.Range("P" & Cell.Row).Resize(, 31).Copy sh_dest.Range("G" & nextRowD)
End With
End If
Next Cell

Sheets("Summary").Select
Call sortTechs

Call addbordertolastrowB
With Application
.ScreenUpdating = True
.Calculation = xlCalculationAutomatic
End With
End Sub
[/VBA]

what kind of jedi mind trick do you have for this:
[VBA]Sub sortTechs()

' clear the old Summary range
Range(Sheets("Summary").Range("B2:C2"), _
Sheets("Summary").Range("B2:C2").End(xlDown)).ClearContents

' copy current range from Library
Range(Sheets("library").Range("AT2:AU2"), _
Sheets("library").Range("AT2:AU2").End(xlDown)).Copy _
Sheets("Summary").Range("B2")

' replace formula with values
Range(Sheets("Summary").Range("B2:C2"), _
Sheets("Summary").Range("B2:C2").End(xlDown)).Value = _
Range(Sheets("Summary").Range("B2:C2"), _
Sheets("Summary").Range("B2:C2").End(xlDown)).Value

Sheets("Summary").Range("B2:C2").End(xlDown).Select ' error here
Selection.Sort Key1:=Range("C1"), Order1:=xlAscending, Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Call FixSummary
Call AddSummaryFormula

End Sub[/VBA]

It errors after our update saying select method of range class failed

here too:
[VBA]
Sub addbordertolastrowB()

Dim LastRowB As Long

With Worksheets("QCDetail") ' .Range("$B:$B")
LastRowB = .cells(.Rows.Count, 1).End(xlUp).Row

Worksheets("QCDetail").Range("B" & LastRowB & ":AK" & LastRowB).Select

With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
End With
.Range("B" & LastRowB).Select
End With
End Sub
[/VBA]
If I click on the page and hit play in the vbe the code finishes fine.
I was trying to avoid sheet select or activate if it slows down the process. but of it has to be there, your help has already made it very zippy

Be very careful that everything is properly qualified and no selecting

[vba]

Sub sortTechs()

With Sheets("Summary")
' clear the old Summary range
.Range(.Range("B2:C2"), .Range("B2:C2").End(xlDown)).ClearContents

' copy current range from Library
Sheets("library").Range(Sheets("library").Range("AT2:AU2"), _
Sheets("library").Range("AT2:AU2").End(xlDown)).Copy .Range("B2")

' replace formula with values
.Range(.Range("B2:C2"), .Range("B2:C2").End(xlDown)).Value = _
.Range(.Range("B2:C2"), .Range("B2:C2").End(xlDown)).Value

.Range("B2:C2").End(xlDown).Sort Key1:=.Range("C1"), _
Order1:=xlAscending, _
Header:=xlYes, _
OrderCustom:=1, _
MatchCase:=False, _
Orientation:=xlTopToBottom
End With

Call FixSummary
Call AddSummaryFormula

End Sub
[/vba]

Outstanding!
Thank you so much.
Mark