Excel with VBA code stops working after a while OR if I try to save the document

Oropher

New Member
Joined
May 5, 2015
Messages
3
Hello guys! I hope you can help me with this trouble.

I have a macro where my vba code is linked to a button. When the user clicks it, the only sub that exists start to run. It copies some data from another workbook, pastes it on a existing worksheet and generates a pivot table from it. The problem is that after the code runs, I cant save it, and after a while (maybe 10 or 5 min) it stops working, the legend simply says that excel "Stoped working".

I've tried to search on google for similar cases, and I've tried to apply them but none has worked so far...

Thanks beforehand guys for your attention!

The vba code:

Sub Icat()
Dim twb As Workbook, awb As Workbook
Dim namepath As Variant
Dim wos As Worksheet, pwos As Worksheet
Dim rang As Range, cll As Range, rac As Range
Dim last As Long, i As Long, rw As Long
Dim arrli() As String, arr As Variant
Dim pvtcache As PivotCache
Dim pvt As PivotTable
Dim start As String
Dim datos As String
Dim pvtfield As PivotField
Dim pvtitem As PivotItem
arrli() = Split("E,F,G,O,R,AG,AH,AI", ",")


Set awb = Application.ActiveWorkbook
Application.ScreenUpdating = False
namepath = Application.GetOpenFilename(FileFilter:="Excel Files(*.XLS;*.XLSX;*.CSV), *.XLS ; *.XLSX; *.CSV", Title:="Select file to be opened")
If namepath = False Then Exit Sub
Set twb = Workbooks.Open(namepath)
twb.Sheets(1).Select
If Range("B2") <> Empty Then
GoTo fail
End If
Set wos = awb.Sheets(2)

Application.DisplayAlerts = False
wos.UsedRange.Clear
On Error Resume Next
ThisWorkbook.Sheets("Icat Pivot Table").Delete
Application.DisplayAlerts = True

twb.Sheets(1).UsedRange.Copy Destination:=awb.Sheets(2).Cells(1, 1)
twb.Close (False)
wos.Activate
Set rang = wos.UsedRange
rang.Columns(1).TextToColumns _
Destination:=wos.Range("A1"), _
DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, _
Tab:=False, _
Semicolon:=False, _
Comma:=True, _
Space:=False, _
Other:=False, _
FieldInfo:=Array(Array(1, 1), Array(2, 2), Array(3, 1), Array(4, 1), Array(5, 3), Array(6, 3), _
Array(7, 3), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), _
Array(14, 1), Array(15, 3), Array(16, 1), Array(17, 1), Array(18, 3), Array(19, 1), Array(20, 1), Array(21, 1), Array(22, 1), Array(23, 1), _
Array(24, 1), Array(25, 1), Array(26, 1), Array(27, 1), Array(28, 1), Array(29, 1), Array(30, 1), Array(31, 1), Array(32, 1), Array(33, 3), _
Array(34, 3), Array(35, 3)), TrailingMinusNumbers:=True
Set rang = wos.UsedRange
rang.Rows(1).Select
Selection.EntireColumn.AutoFit
last = Range("A" & Rows.Count).End(xlUp).Row

For Each arr In arrli
For Each cll In wos.Range(arr & "2:" & arr & last)
cll.NumberFormat = "dd/mm/yy"
If cll.Value <> Empty Then
cll.Value = CLng(Application.WorksheetFunction.RoundDown(CDbl(cll.Value), 0))
End If
Next
Next
i = 1
While wos.Cells(1, i) <> Empty
i = i + 1
Wend
wos.Cells(1, i) = "Time"
Set rac = wos.Range("AI2:AI" & last)
For Each cll In rac
rw = cll.Row
If cll.Value < wos.Cells(rw, 6).Value Then
If Application.WorksheetFunction.NetworkDays_Intl(wos.Cells(rw, 6), Date) = 0 Then
wos.Cells(rw, i).Value = 0
Else
wos.Cells(rw, i) = Application.WorksheetFunction.NetworkDays_Intl(wos.Cells(rw, 6), Date) - 1
End If
Else
If Application.WorksheetFunction.NetworkDays_Intl(cll.Value, Date) = 0 Then
wos.Cells(rw, i).Value = 0
Else
wos.Cells(rw, i) = Application.WorksheetFunction.NetworkDays_Intl(cll.Value, Date) - 1
End If
End If
Next


wos.Rows(1).Interior.Color = RGB(111, 185, 253)
Set pwos = ThisWorkbook.Sheets.Add(After:=awb.Sheets(awb.Sheets.Count))

datos = wos.Name & "!" & wos.UsedRange.Address(ReferenceStyle:=xlR1C1)
start = pwos.Name & "!" & pwos.Range("A3").Address(ReferenceStyle:=xlR1C1)
Set pvtcache = ThisWorkbook.PivotCaches.Create( _
SourceType:=xlDatabase, _
SourceData:=datos)

Set pvt = pvtcache.CreatePivotTable( _
TableDestination:=start, _
TableName:="Icat Table")

pvt.PivotFields("Ticket#").Orientation = xlPageField
pvt.PivotFields("Time").Orientation = xlRowField
pvt.PivotFields("State").Orientation = xlRowField
pvt.PivotFields("Agent/Owner").Orientation = xlColumnField
pvt.AddDataField pvt.PivotFields("Ticket#"), "Count of Tickets", xlCount
pvt.ColumnGrand = True
pvt.RowGrand = True

With pvt

For Each pvtfield In .PivotFields
pvtfield.Subtotals(1) = True
pvtfield.Subtotals(1) = False
Next pvtfield
End With

For Each pvtitem In pvt.PivotFields("Time").PivotItems
pvtitem.Caption = "> " & pvtitem.Caption & " Days"
Next pvtitem



pwos.Name = "Icat Pivot Table"
Application.ScreenUpdating = True
Exit Sub
fail:
MsgBox "The file you attempt to open is not in the correct format. Open the raw data from Icat and try again."
twb.Close False
Application.ScreenUpdating = True

End Sub
 

Excel Facts

Can you sort left to right?
To sort left-to-right, use the Sort dialog box. Click Options. Choose "Sort left to right"

Forum statistics

Threads
1,223,229
Messages
6,170,881
Members
452,364
Latest member
springate

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