ExcelBanter - View Single Post - Excel Experts Needed: Marcors on Shared Documents are slow....

[email protected]

wrote:
Hi.

A collegue of mine created a macro which works very fast (about 30
seconds) when the Workbook is not shared. However, when the Workbook
is shared, the same Macro takes up to 20 minutes. The Workbook is on
the local drive.

Why would a macro take longer to run when the workbook is shared?

Thanks a lot for any replies!

Mike.

BTW...Here is the code for the macro:

' Data sheet format

Daircraft = 4
DSO = 1
DGroup = 3
DAssignee = 5
DETC = 2
Dfirstdatecol = 6

Drowstart = 2

' Manloading sheet format:

MAircraft = 1
MSO = 2
Mprojdescr = 3
MATA = 4
MGroup = 5
Mtasktype = 6
Mtasktitle = 7
Mtaskdescr = 8

MfirstAssignee = 9
Mnbassignee = 5
Massignee1 = MfirstAssignee
Massignee1use = MfirstAssignee + 1
Massignee2 = MfirstAssignee + 2
Massignee2use = MfirstAssignee + 3
Massignee3 = MfirstAssignee + 4
Massignee3use = MfirstAssignee + 5
Massignee4 = MfirstAssignee + 6
Massignee4use = MfirstAssignee + 7
Massignee5 = MfirstAssignee + 8
Massignee5use = MfirstAssignee + 9
Massigneetotaluse = MfirstAssignee + 10

MSSA = 20
MSPL = 21

Mfirstphase = 22
MATMsub = Mfirstphase
MHWtest = Mfirstphase + 1
Mint = Mfirstphase + 2
MIHA = Mfirstphase + 3
Mpwroff = Mfirstphase + 4
Minstall = Mfirstphase + 5
MIFA = Mfirstphase + 6
MRFT = Mfirstphase + 7

Mstartdate = 30
Menddate = 31

MACT = 32
METC = 33
MnewETC = 34
Mpcompl = 35

Mfirstchgnum = 36
Mnbchgnum = 5
Mcomments = Mfirstchgnum + Mnbchgnum

Mrowstart = 2

' EAC TBCR sheet format:

ECrundate = 1 ' Run Date column
ECProjdescr = 2 ' Project Description Column
ECbprojnum = 3 ' BaaN Project number Column
ECprojphase = 4 ' Project Phase
ECdept = 5 ' Dept identifier column
ECCcpn = 6 'Cost component column
ECelem = 7 ' Element identifier column
ECCCN = 8 ' CCN identifier column
ECrnd = 9 ' R&D identifier - R or N
ECActdescr = 10 ' Activity Description
ECchgnum = 11 ' Activity Charge number
ECACT = 12 ' Activity Actual hours
ECcuretc = 13 ' Activity current ETC
ECnewETC = 14 ' Activity new ETC
ECCurbdg = 15 ' Activity Current budget
EChidbdg = 16 ' New budget hidden
ECnewbdg = 17 ' Activity New budget
ECbchgi = 18 ' Budget change indicator
ECbchgv = 19 ' Budget change value
ECtphsh = 20 ' Total phase budget hidden
ECtprjh = 21 ' Total Project budget hidden
ECchgnumclsd = 22 ' Charge number closed indicator hidden
ECGRPclose = 25 ' Group to be closed indicator
Erowstart = 2 ' Starting row of EAC TBCR report

Mrow = Mrowstart

Dim Mlastdate As Date
Dim Mfirstdate As Date
Dim Mdate As Date
Dim Dpctpermonth() As Double

Call Turn_off_display

Mdate = Sheets("TBCR Report").Cells(Erowstart, ECrundate) + 3 '
Monday after weekending

Mfirstdate =
Application.WorksheetFunction.Min(Range(Sheets("Ma nloading").Cells(Mrowstart,
Mstartdate), Sheets("Manloading").Cells(2000, Mstartdate)))
If (Day(Mfirstdate) < 2) Then ' not a Monday
Mfirstdate = Mfirstdate - (Day(Mfirstdate) - 2) 'Date should be
monday
End If

If (Mfirstdate < Mdate) Then
Mfirstdate = Mdate
End If

Mlastdate =
Application.WorksheetFunction.Max(Range(Sheets("Ma nloading").Cells(Mrowstart,
Menddate), Sheets("Manloading").Cells(2000, Menddate)))

Mmaxtime = Mlastdate - Mfirstdate
Mnbmonths = (Year(Mlastdate) - Year(Mfirstdate)) * 12 +
Month(Mlastdate) - Month(Mfirstdate) + 1
Mnbweeks = Round((Mmaxtime / 7 + 0.5))
ReDim Dpctpermonth(Mnbmonths + 1)

' Clear all previous red dates in Manloading File

Worksheets("Manloading").Activate
Range(Cells(Mrowstart, Menddate), Cells(2000, 100)).Select
With Selection.Interior
.ColorIndex = xlColorIndexNone
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With

' Clear sheet and generate title line

Worksheets("Data").Activate
Cells.Select
Selection.AutoFilter
Selection.ClearContents

' Clear selection twice in case autofilter was selected
Selection.AutoFilter
Selection.ClearContents

Sheets("Data").Cells(1, Daircraft) = "Aircraft"
Sheets("Data").Cells(1, DSO) = "SO"
Sheets("Data").Cells(1, DGroup) = "Group"
Sheets("Data").Cells(1, DAssignee) = "Assignee"
Sheets("Data").Cells(1, DETC) = "ETC"

For tempcounter = 0 To (Mnbmonths)
Sheets("Data").Cells(1, Dfirstdatecol + tempcounter) =
DateSerial(Year(Mfirstdate), Month(Mfirstdate) + 1 + tempcounter, 0)
Next tempcounter
Sheets("Data").Range(Cells(1, Dfirstdatecol), Cells(1, Dfirstdatecol
+ tempcounter)).NumberFormat = "[$-409]mmm-yy;@"

Worksheets("Data STS").Activate
Cells.Select
Selection.AutoFilter
Selection.ClearContents

' Clear selection twice in case autofilter was selected
Selection.AutoFilter
Selection.ClearContents

Sheets("Data STS").Cells(1, Daircraft) = "Aircraft"
Sheets("Data STS").Cells(1, DSO) = "SO"
Sheets("Data STS").Cells(1, DGroup) = "Group"
Sheets("Data STS").Cells(1, DAssignee) = "Assignee"
Sheets("Data STS").Cells(1, DETC) = "ETC"

For tempcounter = 0 To (Mnbmonths)
Sheets("Data STS").Cells(1, Dfirstdatecol + tempcounter) =
DateSerial(Year(Mfirstdate), Month(Mfirstdate) + 1 + tempcounter, 0)
Next tempcounter
Sheets("Data STS").Range(Cells(1, Dfirstdatecol), Cells(1,
Dfirstdatecol + tempcounter)).NumberFormat = "[$-409]mmm-yy;@"

Drow = Drowstart
Drow_STS = Drowstart
Denddateerror = False

total_so = Application.CountA(Sheets("Manloading").Columns(MS O)) - 1
Nb_SO = 1

'BELOW IS WHERE IT'S SLOW!!

For Nb_SO = 1 To total_so

' Find next Non-blank SO (Trim not used as spaces are counted in the
Count function
Do Until (Sheets("Manloading").Cells(Mrow, MSO) < "")
Mrow = Mrow + 1
Loop

' do not count Supervision tasks for the manloading charts
If (UCase(Trim(Sheets("Manloading").Cells(Mrow, Mtasktype))) <
"SUPERVISION") Then
If ((Sheets("Manloading").Cells(Mrow, Mstartdate) Mdate) And
(Sheets("Manloading").Cells(Mrow, Mstartdate) < "")) Then
Dstart = Sheets("Manloading").Cells(Mrow, Mstartdate)
Else
Dstart = Mdate
End If

If (Sheets("Manloading").Cells(Mrow, Menddate) < "") Then
Dend = Sheets("Manloading").Cells(Mrow, Menddate)
Else
Dend = Mdate
End If

' Dnbweeks = Round(((Dend - Dstart) / 7 + 0.5), 0)

Dnbmonths = (Year(Dend) - Year(Dstart)) * 12 + Month(Dend) -
Month(Dstart) + 1

If (Dnbmonths < 1) Then
Dnbmonths = 1
Denddateerror = True
With Sheets("Manloading").Cells(Mrow, Menddate).Interior
.ColorIndex = 3
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
End With
End If

' Dstartweek = Round(((Dstart - Mdate) / 7 - 0.5), 0)
Dstartmonth = (Year(Dstart) - Year(Mdate)) * 12 + Month(Dstart) -
Month(Mdate) + 1

For i = 0 To Mnbmonths
Dpctpermonth(i) = 0
Next i

If (Dnbmonths = 1) Then
Dpctpermonth(Dstartmonth) = 1
Else
Nbdaysinfstmonth = Day(DateSerial(Year(Dstart), Month(Dstart) +
1, 0))
Dpctfstmonth = (Nbdaysinfstmonth - Day(Dstart)) /
Nbdaysinfstmonth
Nbdaysinlstmonth = Day(DateSerial(Year(Dend), Month(Dend) + 1,
0))
Dpctlstmonth = Day(Dend) / Nbdaysinlstmonth

Dpcttotmonth = Dnbmonths - 2 + Dpctfstmonth + Dpctlstmonth

Dpctpermonth(Dstartmonth) = Dpctfstmonth / Dpcttotmonth
Dpctpermonth(Dstartmonth + Dnbmonths - 1) = Dpctlstmonth /
Dpcttotmonth
For i = Dstartmonth + 1 To (Dstartmonth + Dnbmonths - 2)
Dpctpermonth(i) = 1 / Dpcttotmonth
Next i

End If
For Massignee = 0 To (Mnbassignee - 1)

Temp_assignee = UCase(Trim(Sheets("Manloading").Cells(Mrow,
(MfirstAssignee + 2 * Massignee))))

If ((Temp_assignee < "") And (Temp_assignee < "STS") And
(Temp_assignee < "STS POTENTIAL") And (Temp_assignee < "INDIA") And
(Temp_assignee < "INDIA POTENTIAL")) Then
Sheets("Data").Cells(Drow, Daircraft) =
Sheets("Manloading").Cells(Mrow, MAircraft)
Sheets("Data").Cells(Drow, DSO) =
Sheets("Manloading").Cells(Mrow, MSO)
Sheets("Data").Cells(Drow, DGroup) =
Sheets("Manloading").Cells(Mrow, MGroup)
Sheets("Data").Cells(Drow, DAssignee) =
Trim(Sheets("Manloading").Cells(Mrow, (MfirstAssignee + 2 *
Massignee)))
Tothours = Sheets("Manloading").Cells(Mrow, MnewETC) *
Sheets("Manloading").Cells(Mrow, (MfirstAssignee + 2 * Massignee + 1))

Sheets("Data").Cells(Drow, DETC) = Tothours
For i = 1 To Mnbmonths
Sheets("Data").Cells(Drow, Dfirstdatecol + i - 1) =
Tothours * Dpctpermonth(i) / 175
Next i

Drow = Drow + 1

ElseIf ((Temp_assignee = "STS") Or (Temp_assignee = "STS
POTENTIAL") Or (Temp_assignee = "INDIA") Or (Temp_assignee = "INDIA
POTENTIAL")) Then

Sheets("Data STS").Cells(Drow_STS, Daircraft) =
Sheets("Manloading").Cells(Mrow, MAircraft)
Sheets("Data STS").Cells(Drow_STS, DSO) =
Sheets("Manloading").Cells(Mrow, MSO)
Sheets("Data STS").Cells(Drow_STS, DGroup) =
Sheets("Manloading").Cells(Mrow, MGroup)
Sheets("Data STS").Cells(Drow_STS, DAssignee) =
Trim(Sheets("Manloading").Cells(Mrow, (MfirstAssignee + 2 *
Massignee)))
Tothours = Sheets("Manloading").Cells(Mrow, MnewETC) *
Sheets("Manloading").Cells(Mrow, (MfirstAssignee + 2 * Massignee + 1))

Sheets("Data STS").Cells(Drow_STS, DETC) = Tothours
' Include ETC validation here
For i = 1 To Mnbmonths
Sheets("Data STS").Cells(Drow_STS, Dfirstdatecol + i - 1)
= Tothours * Dpctpermonth(i) / 175
Next i

Drow_STS = Drow_STS + 1

End If
Next Massignee
End If
Mrow = Mrow + 1

Next Nb_SO
'END OF IT BEING SLOW

Worksheets("Data").Activate
Sheets("Data").Cells.Select
Selection.Sort Key1:=Range("E2"), Order1:=xlAscending,
Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1,
MatchCase:=False _
, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal,
DataOption2:= _
xlSortNormal

Cells.Select
Selection.AutoFilter
Worksheets("Manloading").Activate

Call Reset_display

If Denddateerror Then
MsgBox ("There are Task End Dates earlier then the manloading date
or the Task Start Date! The Dates have been Highlited in red in the
Manloading worksheet.")
End If