| Home |
| Search |
| Today's Posts |
|
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Help for final touch up to my code
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 |
|
#3
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help for final touch up to my code
Bimal,
That is a lot of code so you are asking a lot for us to look deeply at it. However, one big thing jumps out, and that is the constant selecting of sheets and cells. Selecting is costly, hugely inefficient, and rarely necessary. I have appended my stab at what the code would look like without the selects (but you will need to test). The other things you could do are, - set Application.Calculation = xlCalculationManual at teh start, xlCalculatgionAutomatic at the end Here is the 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 Dim i As Long Set Sht1 = Sheets("In") Set Sht2 = Sheets("Report") Worksheets.Add ActiveSheet.Name = "TEMP" Set Sht3 = Sheets("TEMP") Sht2.Cells.Clear With Sht1 Ref1 = 10 .Cells(1, 1).AutoFilter Ref1, Ref2 .Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1) .AutoFilterMode = False Application.DisplayAlerts = False End With Sht3.Range("A:A,E:E,D:D,J:J,K:K,L:L,M:M,N:N").Copy With Sheets("Report") .Range("A1").PasteSpecial Paste:=xlValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Columns("A:A").NumberFormat = "dd-mmm-yy" Application.CutCopyMode = False Sht3.Delete .Columns("H:H").Insert Shift:=xlToRight .Range("H1").Value = "Type" i = 0 With .Range("H2") Do While IsEmpty(.Offset(i, -1)) = False .FormulaR1C1 = "Receipt" i = i + 1 Loop End With End With 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") With Sht1 Ref1 = 8 .Cells(1, 1).AutoFilter Ref1, Ref2 .Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1) .AutoFilterMode = False End With Application.DisplayAlerts = False With Sht3 .Range("B:B,C:C,D:D,E:E,M:M,N:N,O:O").Delete Shift:=xlToLeft .Columns("H:H").Insert Shift:=xlToRight .Range("H1").Value = "Type" i = 0 With Range("H2") Do While IsEmpty(ActiveCell.Offset(0, -1)) = False .FormulaR1C1 = "Issue" i = i + 1 Loop End With .Rows("1:1").Delete Shift:=xlUp .UsedRange.Copy Destination:=Worksheets("Report"). _ Cells(1, 1).End(xlDown).Offset(1, 0) End With Sht2.Columns("A:A").NumberFormat = "dd-mmm-yy" 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") With Sht1 Ref1 = 3 .Cells(1, 1).AutoFilter Ref1, Ref2 .Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1) .AutoFilterMode = False End With Application.DisplayAlerts = False With Sht3 .Range("B:B").Delete Shift:=xlToLeft .Columns("B:C").Cut .Columns("F:G").Insert Shift:=xlToRight .Columns("H:H").Insert Shift:=xlToRight .Range("H1").Value = "Type" i = 0 With .Range("H2") Do While IsEmpty(ActiveCell.Offset(i, -1)) = False .FormulaR1C1 = "Returned" i = i + 1 Loop End With .Rows("1:1").Delete Shift:=xlUp .UsedRange.Copy Destination:=Worksheets("Report"). _ Cells(1, 1).End(xlDown).Offset(1, 0) End With With Sht2 .Columns("A:A").NumberFormat = "dd-mmm-yy" Application.CutCopyMode = False Sht3.Delete Application.DisplayAlerts = True Set Sht1 = Nothing Set Sht2 = Nothing Set Sht3 = Nothing ' +++++++ COMMON .Columns("I:I").Insert Shift:=xlToRight .Range("I1").Value = "Balance" .Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom If .Range("H2").Value = "Receipt" Then .Range("I2").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 With .Range("I2") i = 0 .Offset(1, 0).Select Do Until .Offset(i - 1, 0).Value = "" If .Offset(i, -1).Value = "Issue" Then .Value = (.Offset(i - 1, 0).Value - ..Offset(i, -2).Value) ElseIf .Offset(i, -1).Value = "Receipt" Then .Value = (.Offset(i - 1, 0).Value + ..Offset(i, -2).Value) ElseIf .Offset(i, -1).Value = "Returned" Then .Value = (.Offset(i - 1, 0).Value + ..Offset(i, -2).Value) ElseIf .Offset(i, -1).Value = "Type" Then .Range("A1").Select Exit Sub ElseIf .Offset(i, -1).Value = "" Then .Range("A1").Select Exit Sub End If Loop End With Application.ScreenUpdating = True End Sub -- HTH Bob Phillips ... looking out across Poole Harbour to the Purbecks (remove nothere from the email address if mailing direct) "Bimal" wrote in message m... 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 |
|
#4
Posted to microsoft.public.excel.programming
|
|||
|
|||
|
Help for final touch up to my code
Thankx Bob and Don,
I was playing aroung with your suggetions. Making calc manual save my 50% running time. Also reducing the "selet" further reduced the running time. Now it is around 40-50sec. It took so long because, I am novice in VBA asnd lot of errors kept arising mainly due to my incomplete code in find and replace referances. Thanks again for your help. Regards, Bimal "Bob Phillips" wrote in message ... Bimal, That is a lot of code so you are asking a lot for us to look deeply at it. However, one big thing jumps out, and that is the constant selecting of sheets and cells. Selecting is costly, hugely inefficient, and rarely necessary. I have appended my stab at what the code would look like without the selects (but you will need to test). The other things you could do are, - set Application.Calculation = xlCalculationManual at teh start, xlCalculatgionAutomatic at the end Here is the 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 Dim i As Long Set Sht1 = Sheets("In") Set Sht2 = Sheets("Report") Worksheets.Add ActiveSheet.Name = "TEMP" Set Sht3 = Sheets("TEMP") Sht2.Cells.Clear With Sht1 Ref1 = 10 .Cells(1, 1).AutoFilter Ref1, Ref2 .Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1) .AutoFilterMode = False Application.DisplayAlerts = False End With Sht3.Range("A:A,E:E,D:D,J:J,K:K,L:L,M:M,N:N").Copy With Sheets("Report") .Range("A1").PasteSpecial Paste:=xlValues, _ Operation:=xlNone, _ SkipBlanks:=False, _ Transpose:=False .Columns("A:A").NumberFormat = "dd-mmm-yy" Application.CutCopyMode = False Sht3.Delete .Columns("H:H").Insert Shift:=xlToRight .Range("H1").Value = "Type" i = 0 With .Range("H2") Do While IsEmpty(.Offset(i, -1)) = False .FormulaR1C1 = "Receipt" i = i + 1 Loop End With End With 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") With Sht1 Ref1 = 8 .Cells(1, 1).AutoFilter Ref1, Ref2 .Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1) .AutoFilterMode = False End With Application.DisplayAlerts = False With Sht3 .Range("B:B,C:C,D:D,E:E,M:M,N:N,O:O").Delete Shift:=xlToLeft .Columns("H:H").Insert Shift:=xlToRight .Range("H1").Value = "Type" i = 0 With Range("H2") Do While IsEmpty(ActiveCell.Offset(0, -1)) = False .FormulaR1C1 = "Issue" i = i + 1 Loop End With .Rows("1:1").Delete Shift:=xlUp .UsedRange.Copy Destination:=Worksheets("Report"). _ Cells(1, 1).End(xlDown).Offset(1, 0) End With Sht2.Columns("A:A").NumberFormat = "dd-mmm-yy" 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") With Sht1 Ref1 = 3 .Cells(1, 1).AutoFilter Ref1, Ref2 .Cells(1, 1).CurrentRegion.Copy Sht3.Cells(1, 1) .AutoFilterMode = False End With Application.DisplayAlerts = False With Sht3 .Range("B:B").Delete Shift:=xlToLeft .Columns("B:C").Cut .Columns("F:G").Insert Shift:=xlToRight .Columns("H:H").Insert Shift:=xlToRight .Range("H1").Value = "Type" i = 0 With .Range("H2") Do While IsEmpty(ActiveCell.Offset(i, -1)) = False .FormulaR1C1 = "Returned" i = i + 1 Loop End With .Rows("1:1").Delete Shift:=xlUp .UsedRange.Copy Destination:=Worksheets("Report"). _ Cells(1, 1).End(xlDown).Offset(1, 0) End With With Sht2 .Columns("A:A").NumberFormat = "dd-mmm-yy" Application.CutCopyMode = False Sht3.Delete Application.DisplayAlerts = True Set Sht1 = Nothing Set Sht2 = Nothing Set Sht3 = Nothing ' +++++++ COMMON .Columns("I:I").Insert Shift:=xlToRight .Range("I1").Value = "Balance" .Cells.Sort Key1:=Range("A2"), Order1:=xlAscending, Header:=xlYes, _ OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom If .Range("H2").Value = "Receipt" Then .Range("I2").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 With .Range("I2") i = 0 .Offset(1, 0).Select Do Until .Offset(i - 1, 0).Value = "" If .Offset(i, -1).Value = "Issue" Then .Value = (.Offset(i - 1, 0).Value - .Offset(i, -2).Value) ElseIf .Offset(i, -1).Value = "Receipt" Then .Value = (.Offset(i - 1, 0).Value + .Offset(i, -2).Value) ElseIf .Offset(i, -1).Value = "Returned" Then .Value = (.Offset(i - 1, 0).Value + .Offset(i, -2).Value) ElseIf .Offset(i, -1).Value = "Type" Then .Range("A1").Select Exit Sub ElseIf .Offset(i, -1).Value = "" Then .Range("A1").Select Exit Sub End If Loop End With Application.ScreenUpdating = True End Sub -- HTH Bob Phillips ... looking out across Poole Harbour to the Purbecks (remove nothere from the email address if mailing direct) |
| Reply |
| Thread Tools | Search this Thread |
| Display Modes | |
|
|
Similar Threads
|
||||
| Thread | Forum | |||
| disable touch pad | Excel Worksheet Functions | |||
| Ho do I make my data series touch the axis? | Charts and Charting in Excel | |||
| HELP! My Spreadsheet just disappeared - what did I touch??? | Excel Discussion (Misc queries) | |||
| Can I set up a spreadsheet to count taps on a touch screen? | Excel Discussion (Misc queries) | |||
| Need final code tweak | Excel Programming | |||
![Bimal[_3_] is offline](https://www.excelbanter.com/images/SultanThemeVB3R/statusicon/user_offline.gif)
Linear Mode
