Hi groupe members,
I have joind NG recently and this is my first code. I have searched
the old
posts and collected many code snippets. I have tried to
assamble/modify the
code to suit my requirement which is given below. This code takes more
then two mins for execution during which it scans 3 sheets and around
more
then 8000 rows which is growing day by day. Since I am new in the VBA,
you
may think it as a foolish way of code writing, I have collected bits
and
pieces from old posts of experts and joined them. I will be thankfull
to
you if some body suggests a way to improve the speed and also other
efficient way of handeling this.

My code :
##############

Sub Get_Ledger()

Ref2 = UserForm1.TextBox1.Text
Unload Me
Application.ScreenUpdating = False

'+++++++ IN

Dim Sht1 As Worksheet
Dim Sht2 As Worksheet
Dim Sht3 As Worksheet

Dim Ref1 As Variant

Set Sht1 = Sheets("In")
Set Sht2 = Sheets("Report")

Worksheets.Add
ActiveSheet.Name = "TEMP"

Set Sht3 = Sheets("TEMP")

Sht2.Cells.Clear

Sht1.Select
Ref1 = 10

Sht1.Cells(1, 1).AutoFilter Ref1, Ref2

Sht1.Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1)

Sht1.AutoFilterMode = False

Application.DisplayAlerts = False

Sht3.Activate
Range("A:A,E:E,D:D,J:J,K:K,L:L,M:M,N:N").Select
Selection.Copy
Sheets("Report").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone,
SkipBlanks:= _
False, Transpose:=False
Range("A1").Select
Columns("A:A").Select
Selection.NumberFormat = "dd-mmm-yy"
Range("D19").Select
Application.CutCopyMode = False


Sht3.Delete

Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H1").Value = "Type"
Range("H2").Select

Do While IsEmpty(ActiveCell.Offset(0, -1)) = False

ActiveCell.FormulaR1C1 = "Receipt"

ActiveCell.Offset(1, 0).Select

Loop

Application.DisplayAlerts = True

Set Sht1 = Nothing
Set Sht2 = Nothing
Set Sht3 = Nothing
'++++++++ OUT

Set Sht1 = Sheets("Out")
Set Sht2 = Sheets("Report")

Worksheets.Add
ActiveSheet.Name = "TEMP"

Set Sht3 = Sheets("TEMP")

Sht1.Select
Ref1 = 8

Sht1.Cells(1, 1).AutoFilter Ref1, Ref2

Sht1.Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1)

Sht1.AutoFilterMode = False

Application.DisplayAlerts = False


Sht3.Activate

Range("B:B,C:C,D:D,E:E,M:M,N:N,O:O").Select
Selection.Delete Shift:=xlToLeft

Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H1").Value = "Type"
Range("H2").Select

Do While IsEmpty(ActiveCell.Offset(0, -1)) = False

ActiveCell.FormulaR1C1 = "Issue"

ActiveCell.Offset(1, 0).Select

Loop
Rows("1:1").Select
Selection.Delete Shift:=xlUp

ActiveSheet.UsedRange.Select

Selection.Copy Destination:=Worksheets("Report"). _
Cells(1, 1).End(xlDown).Offset(1, 0)

Sht2.Select
Columns("A:A").Select
Selection.NumberFormat = "dd-mmm-yy"
Range("D19").Select
Application.CutCopyMode = False


Sht3.Delete

Application.DisplayAlerts = True

Set Sht1 = Nothing
Set Sht2 = Nothing
Set Sht3 = Nothing


'++++++ RETURNED

Set Sht1 = Sheets("Returned")
Set Sht2 = Sheets("Report")

Worksheets.Add
ActiveSheet.Name = "TEMP"

Set Sht3 = Sheets("TEMP")

Sht1.Select
Ref1 = 3

Sht1.Cells(1, 1).AutoFilter Ref1, Ref2

Sht1.Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1)

Sht1.AutoFilterMode = False
Application.DisplayAlerts = False
Sht3.Activate

Range("B:B").Select
Selection.Delete Shift:=xlToLeft

Columns("B:C").Select
Selection.Cut
Columns("F:G").Select
Selection.Insert Shift:=xlToRight

Columns("H:H").Select
Selection.Insert Shift:=xlToRight
Range("H1").Value = "Type"
Range("H2").Select

Do While IsEmpty(ActiveCell.Offset(0, -1)) = False

ActiveCell.FormulaR1C1 = "Returned"

ActiveCell.Offset(1, 0).Select

Loop
Rows("1:1").Select
Selection.Delete Shift:=xlUp

ActiveSheet.UsedRange.Select

Selection.Copy Destination:=Worksheets("Report"). _
Cells(1, 1).End(xlDown).Offset(1, 0)


Sht2.Select
Columns("A:A").Select
Selection.NumberFormat = "dd-mmm-yy"
Range("D19").Select
Application.CutCopyMode = False


Sht3.Delete

Application.DisplayAlerts = True
Set Sht1 = Nothing
Set Sht2 = Nothing
Set Sht3 = Nothing

' +++++++ COMMON

Columns("I:I").Select
Selection.Insert Shift:=xlToRight
Range("I1").Value = "Balance"


Cells.Select
Selection.Sort Key1:=Range("A2"), Order1:=xlAscending,
Header:=xlYes, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

Range("I2").Select

If Range("H2").Value = "Receipt" Then
ActiveCell.Value = Range("I2").Offset(0, -2)
Else
MsgBox "There is no receipts, Please enter receipts first OR" &
vbNewLine & _
"Please sort the data"
Exit Sub
End If
ActiveCell.Offset(1, 0).Select
Do Until ActiveCell.Offset(-1, 0).Value = ""

If ActiveCell.Offset(0, -1).Value = "Issue" Then
ActiveCell.Value = (ActiveCell.Offset(-1, 0).Value -
ActiveCell.Offset(0, -2).Value)
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell.Offset(0, -1).Value = "Receipt" Then
ActiveCell.Value = (ActiveCell.Offset(-1, 0).Value +
ActiveCell.Offset(0, -2).Value)
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell.Offset(0, -1).Value = "Returned" Then
ActiveCell.Value = (ActiveCell.Offset(-1, 0).Value +
ActiveCell.Offset(0, -2).Value)
ActiveCell.Offset(1, 0).Select
ElseIf ActiveCell.Offset(0, -1).Value = "Type" Then
Range("A1").Select
Exit Sub
ElseIf ActiveCell.Offset(0, -1).Value = "" Then
Range("A1").Select
Exit Sub

End If

Loop

Application.ScreenUpdating = True

End Sub

############

Any help is appreciated,
Thanks and Regards,
Bimal