Excel 2010 64-bit VBA Macro stops executing for no reason

Agent_V

New Member
Joined
Aug 24, 2007
Messages
19
Hi there,

I have a really bizarre problem with a macro I've written which appears to simply stop executing at a certain point in the code. I am using a 64-bit install of Excel (part of Office Pro Plus edition).

This is the code I've written:

Sub prepBudget2013forFDM()

Debug.Print String(255, vbNewLine)

Application.DisplayAlerts = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual

Dim ws As Worksheet

ActiveWorkbook.Sheets("Cashflow W").Visible = xlSheetVisible
ActiveWorkbook.Sheets("Cashflow W").Delete

For Each ws In ActiveWorkbook.Worksheets

ws.Activate
ws.Visible = xlSheetVisible
ActiveWindow.View = xlNormalView
ActiveWindow.FreezePanes = False
Cells.Select
Selection.ClearOutline
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Next ws

Sheets("Settings").Delete
Sheets("Tips").Delete
Sheets("CashFlow").Delete
Sheets("M Report total").Delete
Sheets("PL total by divisions").Delete
Sheets("PL total").Delete

Sheets("Old style cashflow").Delete
Sheets("CapDisp").Delete
Sheets("Fin lease").Delete
Sheets("CapEx").Delete
Sheets("Bank Borrowing").Delete
Sheets("IC Borrowing").Delete
Sheets("Stock").Delete
Sheets("Bio assets").Delete
Sheets("KPI").Delete
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "FDM"

For Each ws In ActiveWorkbook.Worksheets

If ws.Name = "FDM" Then Exit Sub
If Right(ws.Name, 2) = " R" Or Right(ws.Name, 5) = "total" Then
'Debug.Print ws.Name
Sheets(ws.Name).Delete
Else
ws.Activate
ActiveSheet.Range("A:F,H:Q,S:V,X:AA,AC:AF,AH:AK,AM:AP,AR:AU,AW:AZ,BB:BE,BG:BJ,BL:BO,BQ:BT,BV:BY,CA:CM").Delete Shift:=xlToLeft
Range("a700") = "STOP"
ActiveSheet.Columns("B:B").Select
Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
r = 2
While Cells(r, 1).Value <> "STOP"
If IsNumeric(Cells(r, 15)) Then
If Cells(r, 1).Value = "" Or Cells(r, 15).Value = 0 Or Cells(r, 15).Value = "" Then
Rows(r & ":" & r).Delete Shift:=xlUp
Else
Cells(r, 2).Value = ws.Name
r = r + 1
End If
Else
Rows(r & ":" & r).Delete Shift:=xlUp
End If
Wend
If r = 2 And ws.Name <> "FDM" Then
Sheets(ws.Name).Delete
Else
Rows(r & ":" & r).Delete Shift:=xlUp
If firstCopyDone = True Then Rows("1:1").Delete Shift:=xlUp
Range("A1").Select
Selection.CurrentRegion.Select
numChars = 1
rightChars = Right(Selection.Address, 1)
If InStr(1, Selection.Address, "O") = 0 Then
While IsNumeric(Left(rightChars, 1))
numChars = numChars + 1
rightChars = Right(Selection.Address, numChars)
Wend
charToReplace = Left(rightChars, 1)
newAddr = Replace(Selection.Address, charToReplace, "O")
Range(newAddr).Select
End If
Selection.Copy
Sheets("FDM").Select
Range("A1").Select
Selection.SpecialCells(xlCellTypeLastCell).Select
If Selection.Row <> 1 Then Cells(Selection.Row + 1, 1).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
firstCopyDone = True
End If

End If

Next ws
**** THE MACRO APPEARS TO STOP HERE ****

Sheets("FDM").Select
Range("A1").Select
Selection.CurrentRegion.Select
Dim c As Range
For Each c In Selection.CurrentRegion
Debug.Print c.Row
If c.Column >= 4 And c.Column <= 14 And c.Row > 1 Then
perVal = c.Value
'Debug.Print perVal
c.Value = Cells(c.Row, c.Column - 1) + perVal
End If
Next c

If InStr(1, ActiveWorkbook.Name, "FDM") = 0 Then
ActiveWorkbook.SaveAs Filename:=Left(ActiveWorkbook.Name, Len(ActiveWorkbook.Name) - 5) & " - for FDM.xlsx"
Else
ActiveWorkbook.Save
End If

Application.Calculation = xlCalculationAutomatic
Application.DisplayAlerts = True
Application.ScreenUpdating = True

End Sub

The macro completes all opeartions up to the end of the second for each ws loop. After that it won't execute anything. I have tried adding debug.print commands and message boxes at various points subsequent to the Next ws to see if there is a problem with my code, but none of them worked. If I separate the code from Next ws onward into a separate sub routine I can run it without problems.

I am mystified, anyone experienced anything like this before and hopefully found a solution?
 

Excel Facts

When they said...
When they said you are going to "Excel at life", they meant you "will be doing Excel your whole life".
Nevermind, realise I'm just being plain daft. In fact, if anyone knows how to delete a thread please advise!

As anyone who bothers to look in detail will discover I have an Exit Sub command in my second for loop which I'd obviously gone too square-eyed to notice.

Sorry to trouble you!
 
Upvote 0

Forum statistics

Threads
1,215,149
Messages
6,123,311
Members
449,095
Latest member
Chestertim

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