Solved: a quicker way to do this

[Gtrain]

Ok Guys,

The code i am currently running is quite slow when i am running thousands of lines, and would like to know if anyone has a better way to do this?
in the attached file i have have created basically what i am doing in my full sheet.

it basically copies a 2 cell range in sheet 1 say 1b:1c
then puts this in sheet 2 at the same range then cuts 1c and pastes to 2b

then back to sheet 1 copies 2b:2c
then to sheet 2 places at 3b:3c, cuts 3c and pastes to 4b
etc etc

this becomes pretty slow and renders my pc unusable if i want to edit anything else!

any help would be greatly appreciated, i thought maybe transpose but perhaps that would be just as slow

[Simon Lloyd]

I've not looked at your workbook but after any DIM statements put the code below, also place it before end sub but change calculation to xlAutomatic and the FALSE's to TRUE[VBA]Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual [/VBA]

[Gtrain]

sorry that is just some code, that is in there for the rest of the sheet, i change this elsewhere, i have some quite intensive formulas on each line and don't want them recalculating when a change is made.

[Simon Lloyd]

They don't recalculate because you turn it back on!, and i have no idea what your talking about as i havent looked at your workbook but the suggestion i have given you should cure your problem.

[Gtrain]

Sorry should have explained myself a little better,

These switches are changed to true and xlautomatic elsewhere in my code.

for the purpose of this task please ignore these switches, they are not the problem, the problem is the 40 odd thousand times copying pasting/cutting occurs from sheet to sheet, i would like to know if anyone can think over a better way

[Simon Lloyd]

Its NOT the fact that you use them elsewhere, use them at the start of your copying routine and at the end regardless of where you use them elsewhere, they will make a difference.

[Gtrain]

ok i am willing to try, let you know the outcome, post back soonish

[Gtrain]

Oh wow, I just read your first post again
sorry for the confusion i do already have a sub which i call after dims with xlcalculationmanual and screenupdating false, i will add enable events though

I thought you were saying turn them to true

[Simon Lloyd]

Try this:[VBA]Private Sub addcharDataToSheets()
Dim srcData As Worksheet
Dim destData As Worksheet
Set destData = Worksheets("Sheet2")
Set srcData = Worksheets("Sheet1")
Dim x As Double
Dim y As Double
Dim i As Double
y = 1 'first row of data in template
srcData.Activate
With srcData
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
i = lastRow
For x = 1 To i
srcData.Select
Cells(x, 2).Resize(1, 2).Copy
destData.Select
Cells(y, 2).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Cells(y, 3).Cut
y = y + 1 'move down 1 more row to copy data for east and west
Cells(y, 2).Select
ActiveSheet.Paste
y = y + 1 'move down 1 more row, for new east west data points
Next
End Sub

Private Sub addnumDataToSheets()
Dim srcData As Worksheet
Dim destData As Worksheet
Set destData = Worksheets("Sheet2")
Set srcData = Worksheets("Sheet1")
Dim x As Double
Dim y As Double
Dim i As Double
y = 1 'first row of data in template
srcData.Activate

With srcData
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
i = lastRow

For x = 1 To i
srcData.Select
Cells(x, 1).Resize(1, 1).Copy
destData.Select
Cells(y, 1).Resize(2, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
y = y + 2 'move down 1 more row to copy data for east and west
Next
End Sub
Sub RunAll()
Application.ScreenUpdating = False
Application.EnableEvents = False
Application.Calculation = xlManual
addnumDataToSheets
addcharDataToSheets
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.Calculation = xlAutomatic
End Sub
[/VBA]

[Gtrain]

Simon,

I don't mean to screw you around
I am using screenupdating switches and calculation switches already, which work great, i am just trying to improve the speed further

Adding enableevents went from 431secs to 422secs,

I really wanted to get away from so many copy, paste,cut paste etc

[Bob Phillips]

This is actually slower on your test workbook, but when I increased the data to 100 rows it was 30 times quicker

[vba]

Sub RunAllNew()
Dim mTime As Double

mTime = Timer

Dim Target As Worksheet
Dim LastRow As Long
Dim i As Long

With Application

.ScreenUpdating = False
.Calculation = xlCalculationManual
End With

Set Target = Worksheets("Sheet2")
With Worksheets("Sheet1")

LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Range("B1").Resize(LastRow).Copy Target.Range("B1")
.Range("C1").Resize(LastRow).Copy Target.Range("B1").Offset(LastRow)
.Range("A1").Resize(LastRow).Copy Target.Range("A1")
.Range("A1").Resize(LastRow).Copy Target.Range("A1").Offset(LastRow)
End With

With Target

.Columns("A:B").Sort key1:=.Range("A1"), order1:=xlAscending, Header:=xlNo
End With

With Application

.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
End With

Debug.Print "New: " & Timer - mTime
End Sub
[/vba]

[Gtrain]

Wow, that is very impressive, i will adapt it and test on production sheet, and let you know. I did a quick test with the test file expanded to 20000 rows, errrrrrrr
OLD: 114.53515625
New: 0.09375

Thanks

[Gtrain]

Ahh i see the downfall in this puppy, i was only taking every 3rd row in the production sheet, hence why i was using the loop to copy the lines

i mistakingly put it for every iteration in the testfile and di not specify this

ie x = x + 2
hmmm the saga continues.

any more thoughts

[Bob Phillips]

Do you want to run that by us again, maybe with a new example file?