Making a worksheet macro superfast

[HoogaBooger]

Hi

A basic stocks spreasheet made of 3 worksheets: All(sheet1),
In(Sheet2), and Out(Sheet3).
I need to write a macro which copies/adds the contents of cells from
Worsheet 1, into Worksheet 2 and 3, according to wether the goods move
in or out, for any given date.

I am looking for ways to make the code faster(and maybe shorter) as the
spreadsheet is very very long. I have read about using ranges or arrays,
or using shorthand like -Set rng = Worksheets(1).[a1]-, but somehow I
can't make it work.


Here is what I could come up with so far(sorry about the length):

Sub FlashyMacro()

Screen Update = False
Dim Row1 As Double, Row2 As Double, Row3 As Double, SheetOnScreen As
String
Application.Calculation = xlManual

Row1 = 5
Row2 = 2
Row3 = 2

While Worksheets("Sheet1").Cells(Row1, 1) <> ""
If Worksheets("Sheet1").Cells(Row1, 1) = "In" Then
If Worksheets("Sheet2").Cells(Row2, 1) = "" Then
Worksheets("Sheet2").Cells(Row2, 1) =
Worksheets("Sheet1").Cells(Row1, 2)
[...]
Worksheets("Sheet2").Cells(Row2, 5) =
Worksheets("Sheet1").Cells(Row1, 8)
Else
Worksheets("Sheet2").Cells(Row2, 2) =
Worksheets("Sheet2").Cells(Row2, 2) + Worksheets("Sheet1").Cells(Row1,
5)
[...]
End If
End If
If Worksheets("Sheet1").Cells(Row1, 1) = "Out" Then
' Same for "out"
End If
Row1 = Row1 + 1
If Worksheets("Sheet1").Cells(Row1, 1) = "In" And
Worksheets("Sheet2").Cells(Row2, 1) <> Worksheets("Sheet1").Cells(Row1,
2) Then
Row2 = Row2 + 1
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
End If
Worksheets("Sheet2").Cells(Row2, 1) = ""
[...]
Worksheets("Sheet2").Cells(Row2, 5) = ""
End If
' Same for "OUT"
Wend

Calculate
Application.Calculation = xlAutomatic

Worksheets(SheetOnScreen).Activate

End Sub

Thanks

 

[Tom Ogilvy]

using notation like
[A1]

is actually much slower than using Activesheet.Range("A1") or
Worksheets("Sheet1").Range("A1")

It is difficult to see what you are doing. It appears you are looping over
all the items in the IN sheet, and then what. I didn't really discern an
inner loop where you are looking for a match in the ALL sheet.

It also isn't clear how cells line up. Is the column layout identical. It
did appear that if you found a match, you are incrementing the existing value
for an IN.

If they do, it might be easier to copy all the data from the IN and OUT
sheets to the ALL sheet, then sort so like records line up, then loop through
all the data and consolidate where appropriate - but again, that would
require that the columns line up.

--
Regards,
Tom Ogilvy

Hi

A basic stocks spreasheet made of 3 worksheets: All(sheet1),
In(Sheet2), and Out(Sheet3).
I need to write a macro which copies/adds the contents of cells from
Worsheet 1, into Worksheet 2 and 3, according to wether the goods move
in or out, for any given date.

I am looking for ways to make the code faster(and maybe shorter) as the
spreadsheet is very very long. I have read about using ranges or arrays,
or using shorthand like -Set rng = Worksheets(1).[a1]-, but somehow I
can't make it work.


Here is what I could come up with so far(sorry about the length):

Sub FlashyMacro()

Screen Update = False
Dim Row1 As Double, Row2 As Double, Row3 As Double, SheetOnScreen As
String
Application.Calculation = xlManual

Row1 = 5
Row2 = 2
Row3 = 2

While Worksheets("Sheet1").Cells(Row1, 1) <> ""
If Worksheets("Sheet1").Cells(Row1, 1) = "In" Then
If Worksheets("Sheet2").Cells(Row2, 1) = "" Then
Worksheets("Sheet2").Cells(Row2, 1) =
Worksheets("Sheet1").Cells(Row1, 2)
[...]
Worksheets("Sheet2").Cells(Row2, 5) =
Worksheets("Sheet1").Cells(Row1, 8)
Else
Worksheets("Sheet2").Cells(Row2, 2) =
Worksheets("Sheet2").Cells(Row2, 2) + Worksheets("Sheet1").Cells(Row1,
5)
[...]
End If
End If
If Worksheets("Sheet1").Cells(Row1, 1) = "Out" Then
' Same for "out"
End If
Row1 = Row1 + 1
If Worksheets("Sheet1").Cells(Row1, 1) = "In" And
Worksheets("Sheet2").Cells(Row2, 1) <> Worksheets("Sheet1").Cells(Row1,
2) Then
Row2 = Row2 + 1
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
End If
Worksheets("Sheet2").Cells(Row2, 1) = ""
[...]
Worksheets("Sheet2").Cells(Row2, 5) = ""
End If
' Same for "OUT"
Wend

Calculate
Application.Calculation = xlAutomatic

Worksheets(SheetOnScreen).Activate

End Sub

Thanks

 

[HoogaBooger]

Thank you for your reply.

Sorry, it's all very unclear because I tried to shorten my post b
cutting the code, obviously in the wrong places.

The layout is indeed different in every worksheet.

Here's the code in its full glory:

 

[JLatham]

One easy way to make macros appear to work faster, ONCE YOU KNOW THE LOGIC IS
WORKING PROPERLY, is to simply inhibit the constantly flickering screen as
you jump around between sheets and on them.

Where your code starts doing things like that, simply insert this:

Application.Screenupdating = False

then when you are all done, or at appropriate places like in error trapping
routines, you show the job as all done with a simple

Application.Screenupdating = True

Hi

A basic stocks spreasheet made of 3 worksheets: All(sheet1),
In(Sheet2), and Out(Sheet3).
I need to write a macro which copies/adds the contents of cells from
Worsheet 1, into Worksheet 2 and 3, according to wether the goods move
in or out, for any given date.

I am looking for ways to make the code faster(and maybe shorter) as the
spreadsheet is very very long. I have read about using ranges or arrays,
or using shorthand like -Set rng = Worksheets(1).[a1]-, but somehow I
can't make it work.


Here is what I could come up with so far(sorry about the length):

Sub FlashyMacro()

Screen Update = False
Dim Row1 As Double, Row2 As Double, Row3 As Double, SheetOnScreen As
String
Application.Calculation = xlManual

Row1 = 5
Row2 = 2
Row3 = 2

While Worksheets("Sheet1").Cells(Row1, 1) <> ""
If Worksheets("Sheet1").Cells(Row1, 1) = "In" Then
If Worksheets("Sheet2").Cells(Row2, 1) = "" Then
Worksheets("Sheet2").Cells(Row2, 1) =
Worksheets("Sheet1").Cells(Row1, 2)
[...]
Worksheets("Sheet2").Cells(Row2, 5) =
Worksheets("Sheet1").Cells(Row1, 8)
Else
Worksheets("Sheet2").Cells(Row2, 2) =
Worksheets("Sheet2").Cells(Row2, 2) + Worksheets("Sheet1").Cells(Row1,
5)
[...]
End If
End If
If Worksheets("Sheet1").Cells(Row1, 1) = "Out" Then
' Same for "out"
End If
Row1 = Row1 + 1
If Worksheets("Sheet1").Cells(Row1, 1) = "In" And
Worksheets("Sheet2").Cells(Row2, 1) <> Worksheets("Sheet1").Cells(Row1,
2) Then
Row2 = Row2 + 1
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
End If
Worksheets("Sheet2").Cells(Row2, 1) = ""
[...]
Worksheets("Sheet2").Cells(Row2, 5) = ""
End If
' Same for "OUT"
Wend

Calculate
Application.Calculation = xlAutomatic

Worksheets(SheetOnScreen).Activate

End Sub

Thanks

 

[Tom Ogilvy]

this might be a little faster since it performs fewer individual instructions:

Sub FlashyMacro()

Screen Update = False

Dim Row1 As Double, Row2 As Double
Dim Row3 As Double, SheetOnScreen As String

Application.Calculation = xlManual

Row1 = 4
Row2 = 2
Row3 = 2

SheetOnScreen = ActiveCell.Worksheet.Name
If SheetOnScreen <> "Sheet3" Then
SheetOnScreen = "Sheet2"
End If

Worksheets(SheetOnScreen).Activate
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
Else
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select
End If

Worksheets("Sheet2").Cells(Row2, 1) _
.Resize(1,5).Clearcontents
Worksheets("Sheet3").Cells(Row3, 1) _
.Resize(1,5).Clearcontents



While Worksheets("Sheet1").Cells(Row1, 1) <> ""
If Worksheets("Sheet1").Cells(Row1, 1) = "In" Then
If Worksheets("Sheet2").Cells(Row2, 1) = "" Then

Worksheets("Sheet2").Cells(Row2, 1).Value = _
Worksheets("Sheet1").Cells(Row1, 2)

Worksheets("Sheet2").Cells(Row2, 2) _
.Resize(1,4).Value = Worksheets("Sheet1") _
.Cells(Row1, 5).Resize(1,4).Value

Else

Worksheets("Sheet1").Cells(Row1,5) _
.Resize(1,4).copy

Worksheets("Sheet2").Cells(Row2, 3) _
.Resize(1,4).PasteSpecial xlValue, xlAdd

End If
End If
If Worksheets("Sheet1").Cells(Row1, 1) = "Out" Then
If Worksheets("Sheet3").Cells(Row3, 1) = "" Then

Worksheets("Sheet3").Cells(Row3, 1) = _
DateSerial(Year(Worksheets("Sheet1").Cells(Row1, 3)), _
Month(Worksheets("Sheet1").Cells(Row1, 3)), 1)

Worksheets("Sheet3").Cells(Row3, 2) _
.Resize(1,4).Value = Worksheets("Sheet1") _
.Cells(Row1, 5).Resize(1,4).Value

Else

Worksheets("Sheet1").Cells(row1,5) _
.Resize(1,4).copy

worksheets("Sheet3").Cells(ROW3,2) _
.Resize(1,4).pasteSpecial xlValues, xlAdd

End If
End If
Row1 = Row1 + 1
If Worksheets("Sheet1").Cells(Row1, 1) = "In" And _
Worksheets("Sheet2").Cells(Row2, 1) <> _
Worksheets("Sheet1").Cells(Row1,2) Then
Row2 = Row2 + 1
If (SheetOnScreen = "Sheet2") Then
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select
End If
Worksheets("Sheet2").Cells(Row2, 1) _
.Resize(1,5).clearContents
End If

If Worksheets("Sheet1").Cells(Row1, 1) = "Out" And _
Worksheets("Sheet3").Cells(Row3, 1) <> "" And _
Month(Worksheets("Sheet3").Cells(Row3, 1)) <> _
Month(Worksheets("Sheet1").Cells(Row1, 3)) Then
Row3 = Row3 + 1
If (SheetOnScreen = "Sheet3") Then
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select
End If
Worksheets("Sheet3").Cells(Row3, 1) _
.Resize(1,5).ClearContents
End If
Wend

Worksheets("Sheet1").Activate
Worksheets("Sheet1").Cells(Row1, 1).Select

Worksheets("Sheet3").Activate
Worksheets("Sheet3").Cells(Row3 + 1, 1).Select

Worksheets("Sheet2").Activate
Worksheets("Sheet2").Cells(Row2 + 1, 1).Select

Calculate
Application.Calculation = xlAutomatic

Worksheets(SheetOnScreen).Activate

End Sub

Without knowing more about your data, I would hesitate to do much more.
I don't see where the activating and selecting have anything to do with the
macro except maybe to give you visual feedback. If you don't need that
feedback, you might remove those lines.