Visual basic editor window closes when I run maco

bradyj7

Board Regular
Joined
Mar 2, 2011
Messages
106
Hi All,

When I run the macro below the VB editor window (the place where you enter the code) closes and noting happens. I can't understand this because the code is pretty simple. Any ideas? - been at it all day :(

Code:
Sub torque_kin()


Dim LastRow As Long
Dim starttime
Dim k As Integer
Dim i As Integer
Dim x As Long


' Turn off screenupdating:
Application.ScreenUpdating = False



'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''PART 1 - WORKSHEET SETUP''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''

Range("a:A").NumberFormat = "dd/mm/yyyy hh:mm:ss"
Cells.Copy

Application.DisplayAlerts = False
ActiveWorkbook.Close ([savechanges:=False])
Application.DisplayAlerts = True



Columns("a:AZ").Select
Selection.Delete
Cells.Select
Application.DisplayAlerts = False
ActiveSheet.Paste
Application.DisplayAlerts = True

'Check Column A for Duplicate values, if so delete entire row
LastRow = Range("A65536").End(xlUp).row
For x = LastRow To 1 Step -1
If Application.WorksheetFunction.CountIf(Range("A1:A" & x), Range("A" & x)) > 1 Then
Range("A" & x).EntireRow.Delete
End If
Next x


'create raw worksheet
Worksheets("raw").Activate
Cells.Delete

'open leftmost sheet in workbook because name is different in each file
Worksheets(1).Activate

'copy log time into raw
Range("a:a").Copy
Worksheets("raw").Activate
Range("b1").Select
ActiveSheet.Paste

Worksheets(1).Activate

'copy speed into raw
Range("c:c").Copy
Worksheets("raw").Activate
Range("c1").Select
ActiveSheet.Paste

Worksheets(1).Activate

'copy 'Event' into raw
Range("e:e").Copy
Worksheets("raw").Activate
Range("e1").Select
ActiveSheet.Paste



'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''PART 2 - KINEMATIC SETUP in raw worksheet'''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''''''''



Worksheets("raw").Select

'''''''''''''''''''''''''''''''''''''''''''''''''
''''''lastrow DO not delete rows after this''''''
'''''''''''''''''''''''''''''''''''''''''''''''''

LastRow = Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).row

'''''''''''''''''''''''''''''''''''''''''''''''''
'''''''''''''''''''''''''''''''''''''''''''''''''

Range("a1").Value = "ID key"
Range("a2").Value = 1
Range("a3:a" & LastRow).FormulaR1C1 = "=r[-1]c+1"


Range("d1").FormulaR1C1 = "Speed [m/s]"
Range("d2:d" & LastRow).FormulaR1C1 = "=rc[-1]/3.6"




Range("f2:f" & LastRow).FormulaR1C1 = "=(rc[-4]-r[-1]c[-4])*86400"


'acc

Range("g1").Value = "Acc [m/s2]"
Range("g2").Value = 0


Range("g3:g" & LastRow).FormulaR1C1 = "=if(rc[-1]=0,0,(RC[-3]-R[-1]C[-3])/RC[-1])"


'distance

Range("h1").FormulaR1C1 = "Distance [m]"
Range("h2").Value = 0
Range("h3:h" & LastRow).FormulaR1C1 = "=RC[-2]*RC[-4]"


'absolute distance

Range("i1").FormulaR1C1 = "ABS Distance [m]"
Range("i2").Value = 0
Range("i3:i" & LastRow).FormulaR1C1 = "=R[-1]C+R[-1]C[-1]"



'kinematic sequence start point loop

Range("j1").FormulaR1C1 = "Kin Start"

i = 1

Range("j2").Select

'do loop to check 3 things, conditions are 1 and 2, or 3:
'1. acc is +ve
'2. speed is zero
'3. duration is greater then 120secs (engine considered off above this)



Do

If (ActiveCell.Offset(0, -3) < 0 And ActiveCell.Offset(0, -6) = 0) Or ActiveCell.Offset(0, -4).Text = "Journey End Event" Then

ActiveCell.Value = i
i = i + 1


End If

ActiveCell.Offset(1, 0).Select

Loop Until IsEmpty(ActiveCell.Offset(0, -1))

Range("k1").FormulaR1C1 = "VFI"

'if the obd speed at the lastrow is not a zero, the final kinematic segment might not be captured,
'so the following forces another kinematic sequence "end point" at the lastrow

Range("j" & LastRow).Value = i


'autofilter
With ActiveSheet
.AutoFilterMode = False
.Range("A1:k1").AutoFilter
End With



'format raw worksheet
Worksheets("raw").Select
With Worksheets("raw")
.Range("b:b").NumberFormat = "dd/mm/yyyy hh:mm:ss"
.Range("a1:z1").WrapText = True
.Rows("1:1").RowHeight = 73.5
.Range("c1").Value = "Speed(km/h)"
.Range("f1").Value = "Difference in time interval (sec)"
.Range("b:b").ColumnWidth = 18
.Range("c:z").HorizontalAlignment = xlCenter
End With

End Sub
Code:
 

Excel Facts

VLOOKUP to Left?
Use =VLOOKUP(A2,CHOOSE({1,2},$Z$1:$Z$99,$Y$1:$Y$99),2,False) to lookup Y values to left of Z values.
If the workbook containing the code is the activeworkbook, this line closes it and ends code execution:
Code:
ActiveWorkbook.Close
 
Upvote 0

Forum statistics

Threads
1,214,591
Messages
6,120,427
Members
448,961
Latest member
nzskater

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top