CODEWITHSUNDEEP
excelvba
rupes0610
rupes0610

Reputation: 271

Excel freezes when recording macro

I have an existing .xlsm file that runs perfectly with all of the macros. The problem is that when I attempt to record another macro, I add a column, press enter, and get the message "Microsoft Excel has stopped responding". I then have to end the process. I am assuming that this has something to do with the existing macro which was imported from Excel 2003 and modified to work for 2010.

Are there any incompatabilities within this macro that could cause this issue?

 Sub Auto_Open()

    Wbname = ActiveWorkbook.Name  ' this needs to be first so the move works properly
    fileToOpen = Application.GetOpenFilename("CSV files (*.csv), *.csv", 1, "Select file to open")
    If fileToOpen <> False Then
        Workbooks.Open (fileToOpen)
    End If

    sheetname = ActiveSheet.Name

    Sheets(sheetname).Select
    Sheets(sheetname).Move Before:=Workbooks(Wbname).Sheets(1)

    Call Weekly_RTP

 End Sub

Sub Weekly_RTP()
'
' Macro recorded 01/12/12 by Robert Gagliardi
'
'   This next section (up to call sort_data) is needed until we get the formatting correct.
'   Clearing the last rows and adding misc headers will solve the short term problem
'   Need this once pivot table is created.  Can't have heading row without names in it
    Range("L1").Select
    ActiveCell.FormulaR1C1 = "Misc"
    Range("M1").Select
    ActiveCell.FormulaR1C1 = "Misc1"
    Columns("N:Z").Select
    Selection.ClearContents

    Call Sort_data

    ' concat mui & object to make it easy to find dups use countifs once at excel 2007 or greater
    Range("N1").Select
    ActiveCell.FormulaR1C1 = "Junk"
    Range("N2").Select
    ActiveCell.FormulaR1C1 = "=RC[-7]&RC[-5]"
    Range("N2").Select
    Selection.Copy
'    need to find last row using column K2
    lastrow = ActiveSheet.Range("K2").End(xlDown).Select
'    Selection.Offset(0, 3).Select   Moves over 3 cells
    Range("N2", Selection.Offset(0, 3)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False


    Columns("C:C").Select
    Selection.Insert Shift:=xlToRight
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "Alerts"
    Range("C2").Select
    ActiveCell.FormulaR1C1 = "=IF(COUNTIF(R2C[12]:RC15,RC[12])=1,COUNTIF(C[12],RC[12]),"" "")"
    Range("C2").Select
    Selection.Copy
'    need to find last row using column B2 since column C was just added
    lastrow = ActiveSheet.Range("B2").End(xlDown).Select
'    Selection.Offset(0, 1).Select   Moves over 1 cell from last cell in column B
    Range("C2", Selection.Offset(0, 1)).Select
    ActiveSheet.Paste
    Application.CutCopyMode = False


    Call Create_pivot
    Call Save_data

'   how to select a range of cells with data in them
'    Worksheets(ActiveSheet.Name).Activate
'    ActiveCell.CurrentRegion.Select

End Sub


Sub Create_pivot()

    Wbname = ActiveWorkbook.Name

'   Insert columns to make room for pivot table
    Columns("A:I").Select
    Selection.Insert Shift:=xlToRight

    myData = Sheets(ActiveSheet.Name).[J1].CurrentRegion.Address
    mySheet = ActiveSheet.Name & "!"
    tableDest = "[" & Wbname & "]" & mySheet & "R1C1"
    ActiveWorkbook.PivotCaches.Add(SourceType:=xlDatabase, SourceData:= _
        mySheet & myData).CreatePivotTable TableDestination:=tableDest, TableName _
        :="RTP_alerts", DefaultVersion:=xlPivotTableVersionCurrent
    With ActiveSheet.PivotTables("RTP_alerts").PivotFields("Application")
        .Orientation = xlRowField
        .Position = 1
    End With
    With ActiveSheet.PivotTables("RTP_alerts").PivotFields("Object")
        .Orientation = xlRowField
        .Position = 2
    End With
    ActiveSheet.PivotTables("RTP_alerts").AddDataField ActiveSheet.PivotTables( _
        "RTP_alerts").PivotFields("Alerts"), "Count of Alerts", xlCount
    ActiveWorkbook.ShowPivotTableFieldList = False
    Application.CommandBars("PivotTable").Visible = False

    Columns("G:I").Select
    Selection.Delete Shift:=xlToLeft
    Range("D2").Select
    ActiveCell.FormulaR1C1 = "Owner"
    Range("E2").Select
    ActiveCell.FormulaR1C1 = "Problem Ticket"
    Columns("E:E").ColumnWidth = 13
    Range("F2").Select
    ActiveCell.FormulaR1C1 = "Comments"
    Columns("F:F").ColumnWidth = 48

End Sub

Sub Save_data()

    Filename = ActiveWorkbook.Name
    Do
        Fname = Application.GetSaveAsFilename(Filename, fileFilter:="Excel Files (*.xlsm), *.xlsm")
    Loop Until Fname <> False
    ActiveWorkbook.SaveAs Filename:=Fname, FileFormat:=52

End Sub

Sub Sort_data()

    Columns("A:M").Select
    Selection.Sort Key1:=Range("G2"), Order1:=xlAscending, Key2:=Range("I2") _
        , Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:= _
        False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, DataOption2 _
        :=xlSortNormal
    Range("A1").Select

End Sub

Upvotes: 0

Views: 5075

Answers (1)

Dou
Dou

Reputation: 11

I experienced the same problem, here's something you can try. Go to start-->run, and type %temp% in the box. This will bring up your temporary files.

Delete all or some of them, restart your computer and try again.

Upvotes: 1

Related Questions