macro working very slow
 

Hi,

I have this code which works very very slow and hangs sometimes a
well...... can something be done ???

'MsgBox "Please wait while data is UPLOADED in the database, Press O
and wait for a few minutes!!!"
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False


''remove blank rows in enter data sheet
'
'Sheets("Enter Data").Select
'Dim column_with_blanks As Long
'column_with_blanks = 1
'On Error Resume Next 'In case there are no blank rows
'Columns(column_with_blanks).SpecialCells(xlCellTy peBlanks).EntireRow.Delete
'On Error GoTo 0
'
''Shift recently fed data from "enter data" sheet to "database" sheet
'
' Sheets("Enter Data").Select
' Range("E2").Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.Copy
' Sheets("Database").Select
' Range("A2").Select
' Selection.Insert Shift:=xlDown
' Sheets("Enter Data").Select
' Range("A2:D2").Select
' Range(Selection, Selection.End(xlDown)).Select
' Application.CutCopyMode = False
' Selection.Copy
' Sheets("Database").Select
' Range("B2").Select
' Selection.Insert Shift:=xlDown
'
''Remove Dup Names
' Cells.Sort Key1:=Range("A1")
' totalrows = ActiveSheet.UsedRange.Rows.Count
' For Row = totalrows To 2 Step -1
' If Cells(Row, 1).Value = Cells(Row - 1, 1).Value Then
' Rows(Row).Delete
' End If
' Next Row
'
'
' Cells.Select
' Selection.Sort Key1:=Range("a1"), Order1:=xlAscending
Header:=xlNo, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'pasting data in the reports sheet

Application.CutCopyMode = False
Sheets("Database").Select
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Reports").Select
Range("b38").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets("Database").Select
Range("D1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Reports").Select
Range("d38").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

'arranging data TL wise
Range("b38:d38").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("d38"), Order1:=xlAscending
Key2:=Range("c38" _
), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1
MatchCase:= _
False, Orientation:=xlTopToBottom

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Calculate


MsgBox "Data is updated now!!!

--
Message posted from http://www.ExcelForum.com

macro working very slow
 

For one thing, try to get rid of the selections

range("a2").select
selection.copy
range("b2").select
selection.paste
can be
sheets("sheet1").range("a2").copy sheets("sheet2").range("b2")
or if you just want the values
sheets("sheet2").range("b2")=sheets("sheet1").rang e("a2")

--
Don Guillett
SalesAid Software

"paritoshmehta " wrote in
message ...
Hi,

I have this code which works very very slow and hangs sometimes as
well...... can something be done ???

'MsgBox "Please wait while data is UPLOADED in the database, Press OK
and wait for a few minutes!!!"
'
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False


''remove blank rows in enter data sheet
'
'Sheets("Enter Data").Select
'Dim column_with_blanks As Long
'column_with_blanks = 1
'On Error Resume Next 'In case there are no blank rows

'Columns(column_with_blanks).SpecialCells(xlCellTy peBlanks).EntireRow.Delete
'On Error GoTo 0
'
''Shift recently fed data from "enter data" sheet to "database" sheet
'
' Sheets("Enter Data").Select
' Range("E2").Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.Copy
' Sheets("Database").Select
' Range("A2").Select
' Selection.Insert Shift:=xlDown
' Sheets("Enter Data").Select
' Range("A2:D2").Select
' Range(Selection, Selection.End(xlDown)).Select
' Application.CutCopyMode = False
' Selection.Copy
' Sheets("Database").Select
' Range("B2").Select
' Selection.Insert Shift:=xlDown
'
''Remove Dup Names
' Cells.Sort Key1:=Range("A1")
' totalrows = ActiveSheet.UsedRange.Rows.Count
' For Row = totalrows To 2 Step -1
' If Cells(Row, 1).Value = Cells(Row - 1, 1).Value Then
' Rows(Row).Delete
' End If
' Next Row
'
'
' Cells.Select
' Selection.Sort Key1:=Range("a1"), Order1:=xlAscending,
Header:=xlNo, _
' OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

'pasting data in the reports sheet

Application.CutCopyMode = False
Sheets("Database").Select
Range("A1:B1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Reports").Select
Range("b38").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
Sheets("Database").Select
Range("D1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Reports").Select
Range("d38").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False

'arranging data TL wise
Range("b38:d38").Select
Range(Selection, Selection.End(xlDown)).Select
Application.CutCopyMode = False
Selection.Sort Key1:=Range("d38"), Order1:=xlAscending,
Key2:=Range("c38" _
), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1,
MatchCase:= _
False, Orientation:=xlTopToBottom

Application.EnableEvents = True
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Calculate


MsgBox "Data is updated now!!!"


---
Message posted from http://www.ExcelForum.com/