macro working very slow

  • Thread starter Thread starter paritoshmehta
  • Start date Start date
P

paritoshmehta

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(xlCellTypeBlanks).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!!!
 
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").range("a2")
 
Back
Top