Excel Hangs when running Macro unless resource monitor open on top of excel??????

I have a very strange problem today. I have a spreadsheet that I have been developing for years to create hundreds of price lists. There are 20 price list tabs and the macro loops through a list of accounts bringing in one at a time. It then looks up the specific pricing (formula based) it then filters the lists and adjusts page breaks and formats to suit. finally it groups all sheets applicable to the specific account and saves them as a PDF file. Then I cycle through all of the sheets and build a single sheet list that is saved as an .xls file that customers can use to automate data entry on their systems. I have been using this sheet for years and years, adjusting when required. Now for some reason it hangs every few sheets while creating the excel sheet. It is not consistent and could stop after a few or run a dozen or more. It does not error off and go into debug. All of excel hangs and I have to crash it off and restart it to continue. I have found that if the task manager and the resource monitor are open on top of excel it works fine. If excel is on top it will fall over.

Does anyone have any ideas? I have rewritten the entire thing and have not solved it. I don't think it is the code. This is driving me mad!!

JimBobBowie

Hi nathansav,

Sorry no, the sheet is company proprietary and it is way too large (excess of 125 meg). I can tell you that it hangs when copying and formatting rows from one sheet to another in the same workbook. it hangs randomly, never on the same sheet or row. I am using a dell OptiPlex 790 (i5) with 32 bit windows and office 2010. it runs fine if the task manager and resource monitor are open on top. It is just too weird. Do I need to add a wait time after each row copy? I am just guessing. I know it is difficult without code and date but I don't think it is the code. I am to get a newer PC next week. still an i5 but with 64 bit windows and office 2013. This may solve it.



JimBobBowie

Here is the procedure that is running when it hangs. This may help.

JimBobBowie

Sub Create_Excel_Data_Sheet()
'
Dim i, SRow, TRow, BoldLine
Dim CusName, EffectiveRange, Header1, Header2, Header3, Header4, Header5, Header6, Header7, Header8, Header9, Header10, Header11, Header12, Header13
Dim Data1, DATA2, DATA3, DATA4, DATA5, DATA6, DATA7, DATA8
Dim oldStatusBar

Application.Calculation = xlManual

oldStatusBar = Application.DisplayStatusBar
Application.DisplayStatusBar = True
Application.ScreenUpdating = False

i = 2
SRow = 6
TRow = 6
TargetCol = 1
PNUM = ""

Sheets(1).Select
CusName = Range("A5").Value
EffectiveRange = Range("A7").Value
Sheets(2).Select
Header1 = Range("A3").Value
Header2 = Range("B3").Value
Header3 = Range("C3").Value
Header4 = Range("D3").Value
Header5 = Range("E3").Value
Header6 = Range("F3").Value
Header7 = Range("G3").Value
Header8 = Range("B4").Value
Header9 = Range("C4").Value
Header10 = Range("D4").Value
Header11 = Range("E4").Value
Header12 = Range("G5").Value
Header13 = "Price Status"

Sheets("Excel Version").Select

Rows("5:1048576").Select
With Selection
    .WrapText = False
    .Orientation = 0
    .AddIndent = False
    .ShrinkToFit = False
    .ReadingOrder = xlContext
    .MergeCells = False
End With
Range("A1").Select


Range("A6:G1048576").Select
Selection.RowHeight = 16
With Selection.Font
    .Name = "Tahoma"
    .FontStyle = "Regular"
    .Size = 11
    .Strikethrough = False
    .Superscript = False
    .Subscript = False
    .OutlineFont = False
    .Shadow = False
    .Underline = xlUnderlineStyleNone
    .ColorIndex = xlAutomatic
    .TintAndShade = 0
    .ThemeFont = xlThemeFontNone
End With
Cells.Select
Selection.ClearContents

Range("A1").Value = CusName
Range("E1").Value = EffectiveRange
Range("A3") = Header1
Range("B3") = Header2
Range("C3") = Header3
Range("D3") = Header4
Range("E3") = Header5
Range("F3") = Header6
Range("G3") = Header7
Range("B4") = Header8
Range("C4") = Header9
Range("D4") = Header10
Range("E4") = Header11
Range("A2") = Header12
Range("H3").Value = Header13

    For i = 2 To 19
        
        Sheets(i).Select
        
    '  ****************   Dispalay Status Bar Message  ************************
    Application.StatusBar = "Creating Excel Version - Processing Sheet ... " & Sheets(i).Name
    '  ************************************************************************
        
        
        
        If Range("U4").Value > 5 Then
            
            For SRow = 6 To 1000
                
                If Range(Cells(SRow, 22), Cells(SRow, 22)).Value = 1 Then
                
                    Data1 = Range(Cells(SRow, 1), Cells(SRow, 1)).Value
                    DATA2 = Range(Cells(SRow, 2), Cells(SRow, 2)).Value
                    DATA3 = Range(Cells(SRow, 3), Cells(SRow, 3)).Value
                    DATA4 = Range(Cells(SRow, 4), Cells(SRow, 4)).Value
                    DATA5 = Range(Cells(SRow, 5), Cells(SRow, 5)).Value
                    DATA6 = Range(Cells(SRow, 6), Cells(SRow, 6)).Value
                    DATA7 = Range(Cells(SRow, 7), Cells(SRow, 7)).Value
                    DATA8 = Range(Cells(SRow, 23), Cells(SRow, 23)).Value
                    
                    If Range(Cells(SRow, 21), Cells(SRow, 21)).Value = "Page" Then
                        If Range(Cells(SRow, 5), Cells(SRow, 5)).Value = "" Then
                            BoldLine = 1
                        End If
                    End If
                    
                    
                    
                    Sheets("Excel Version").Select
                    
                    Range(Cells(TRow, 1), Cells(TRow, 1)).Value = Data1
                    Range(Cells(TRow, 2), Cells(TRow, 2)).Value = DATA2
                    Range(Cells(TRow, 3), Cells(TRow, 3)).Value = DATA3
                    Range(Cells(TRow, 4), Cells(TRow, 4)).Value = DATA4
                    Range(Cells(TRow, 5), Cells(TRow, 5)).Value = DATA5
                    Range(Cells(TRow, 6), Cells(TRow, 6)).Value = DATA6
                    Range(Cells(TRow, 7), Cells(TRow, 7)).Value = DATA7
                    Range(Cells(TRow, 8), Cells(TRow, 8)).Value = DATA8
                    
                    Range(Cells(TRow, 8), Cells(TRow, 8)).Select
                    Call CodeNewPriceChangeSymbols
                    
                    If BoldLine = 1 Then
                    
                        Range(Cells(TRow, 1), Cells(TRow, 1)).Font.Size = 12
                        Range(Cells(TRow, 1), Cells(TRow, 1)).Font.Bold = True
                        BoldLine = 0
                        
                    End If
                    
                    If Left(Data1, 8) = "Charcoal" Then
                        
                        specialformatrow = TRow

                    End If
                    
                    TRow = TRow + 1
                    Sheets(i).Select
                    
                End If
                If Range(Cells(SRow, 19), Cells(SRow, 19)).Value = "Last" Then
                    SRow = 1000
                End If
            Next
        End If
    SRow = 6
    
    Next

'*********page breaks *************
    Sheets("Excel Version").Select

    ActiveSheet.ResetAllPageBreaks
    With ActiveSheet.PageSetup
        .PrintTitleRows = "$1:$5"
        .PrintTitleColumns = ""
    End With
    ActiveSheet.PageSetup.PrintArea = ""
    With ActiveSheet.PageSetup
        .LeftHeader = ""
        .CenterHeader = ""
        .RightHeader = ""
        .LeftFooter = ""
        .CenterFooter = ""
        .RightFooter = ""
        .LeftMargin = Application.InchesToPoints(0.708661417322835)
        .RightMargin = Application.InchesToPoints(0.708661417322835)
        .TopMargin = Application.InchesToPoints(0.748031496062992)
        .BottomMargin = Application.InchesToPoints(0.748031496062992)
        .HeaderMargin = Application.InchesToPoints(0.31496062992126)
        .FooterMargin = Application.InchesToPoints(0.31496062992126)
        .PrintHeadings = False
        .PrintGridlines = False
        .PrintComments = xlPrintNoComments
        .CenterHorizontally = True
        .CenterVertically = False
        .Orientation = xlPortrait
        .Draft = False
        .PaperSize = xlPaperA4
        .FirstPageNumber = xlAutomatic
        .Order = xlDownThenOver
        .BlackAndWhite = False
        .Zoom = 63
        .PrintErrors = xlPrintErrorsDisplayed
        .OddAndEvenPagesHeaderFooter = False
        .DifferentFirstPageHeaderFooter = False
        .ScaleWithDocHeaderFooter = True
        .AlignMarginsHeaderFooter = True
        .EvenPage.LeftHeader.Text = ""
        .EvenPage.CenterHeader.Text = ""
        .EvenPage.RightHeader.Text = ""
        .EvenPage.LeftFooter.Text = ""
        .EvenPage.CenterFooter.Text = ""
        .EvenPage.RightFooter.Text = ""
        .FirstPage.LeftHeader.Text = ""
        .FirstPage.CenterHeader.Text = ""
        .FirstPage.RightHeader.Text = ""
        .FirstPage.LeftFooter.Text = ""
        .FirstPage.CenterFooter.Text = ""
        .FirstPage.RightFooter.Text = ""
    End With
    
'***** find lastrow *****
Sheets("Excel Version").Select
blankline = 0
countrow = 6
LineCount = 0
Do While blankline < 2

If Range(Cells(countrow, 1), Cells(countrow, 1)).Value = "" Then
    blankline = blankline + 1
Else
    blankline = 0
End If
LineCount = LineCount + 1
countrow = countrow + 1

Loop
lastrow = LineCount + 4

    Range(Cells(8, 1), Cells(lastrow, 1)).Select
    Selection.NumberFormat = "@"
    With Selection
        .HorizontalAlignment = xlLeft
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = True
        .IndentLevel = 1
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With

    Range(Cells(8, 2), Cells(lastrow, 8)).Select
    Selection.NumberFormat = "@"
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
        Range(Cells(8, 5), Cells(lastrow, 5)).Select
        Selection.NumberFormat = "$#,##0.00"
        
    If specialformatrow <> "" Then
        Application.DisplayAlerts = False
        Range(Cells(specialformatrow, 8), Cells(specialformatrow, 8)).ClearContents
        Rows(specialformatrow & ":" & specialformatrow).Select
        Selection.RowHeight = 40
        Range(Cells(specialformatrow, 1), Cells(specialformatrow, 8)).Select
        With Selection
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 0
            .AddIndent = False
            .IndentLevel = 0
            .ShrinkToFit = False
            .ReadingOrder = xlContext
            .MergeCells = True
        End With
        Selection.Merge
    Application.DisplayAlerts = True
    End If
    
'****** end find lastrow **********

pagelenghtrow = 6
looking = 1
For checkrow = 6 To lastrow

    If looking = 1 Then
        stoploop = 0
        prevrow = checkrow
        checkrow = pagelenghtrow + 70
        looking = 0
    End If
    If checkrow = prevrow + 1 Then
        stoploop = 1
        checkrow = pagelenghtrow + 69
    End If
    If stoploop = 1 Then
        If Range(Cells(checkrow, 1), Cells(checkrow, 1)).Value = "" Then
            checkrow = checkrow + 1
            Rows(checkrow & ":" & checkrow).Select
            ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
            pagelenghtrow = checkrow
            looking = 1
        End If
    End If
    If Range(Cells(checkrow, 1), Cells(checkrow, 1)).Font.Bold Then
        Rows(checkrow & ":" & checkrow).Select
        ActiveWindow.SelectedSheets.HPageBreaks.Add Before:=ActiveCell
        pagelenghtrow = checkrow
        looking = 1
    Else
        checkrow = checkrow - 2
    End If
    
    
Next

Application.StatusBar = False
Application.DisplayStatusBar = oldStatusBar
'**********************************
Application.ScreenUpdating = True
Application.Calculation = xlAutomatic
End Sub

Ihave re-wrtiiten the section where I was finding the last row (I have learned alot sense that was done in 2005) and tidyed up the formating sections and it seems to work as intended not. Very strange though. Still not sure what the real problem was.

The problem recurred and I found that disabling the power pivot add-in sorted it all out.

JimBobBowie