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
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