code interrupted error not able to figure out problem

M

mufy_cw

New Member
Joined
Dec 20, 2018
Messages
3
Hi Everyone,
I am new to this forum and specially subscribed to get my query resolved.

I have a system from where I download the report which is not in good format. Also the data is dynamic it keeps on increasing and decreasing
I always have to copy it to a new workbook and format. Since this is a repeated activity i created the code and saved it in personal workbook so I can use it after dowloading the report but it gives me "Code Interrupted error"
Code: 
Sub copy()
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveSheet.UsedRange.Select
Selection.copy
Workbooks.Add
ActiveSheet.Paste
Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlLTR
        .MergeCells = False
    End With
End Sub
this code gives code interrupted error at "Application.CutCopyMode = False"

Then I tried this:

Code: 
Sub copy()
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveSheet.UsedRange.Select
Selection.copy
Workbooks.Add
ActiveSheet.Paste
'Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlLTR
        .MergeCells = False
    End With
End Sub

This code gives code interrupted error at "With Selection"

Then i tried this:

Code: 
Sub copy()
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select
ActiveSheet.UsedRange.Select
Selection.copy
Workbooks.Add
ActiveSheet.Paste
'Application.CutCopyMode = False
'    With Selection
'        .HorizontalAlignment = xlGeneral
'        .VerticalAlignment = xlTop
'        .WrapText = False
'        .Orientation = 0
'        .AddIndent = False
'        .IndentLevel = 0
'        .ShrinkToFit = False
'        .ReadingOrder = xlLTR
'        .MergeCells = False
'    End With
End Sub
This code gives code interrupted error at "end sub"


I dont know what is wrong I am going crazy over it i have tried so many things but unable to figure out what is wrong....
I really need someone to help show what is wrong in the code and what is the correct code..
Actual code was as below it was working find and I dont know how suddenly it started giving error at "Application.CutCopyMode = False" so I cut the remaining code anc copied starting code as above and tried to figure the problem in the above starting code

Code: 
Sub CS282WCOUNT()
Application.ScreenUpdating = False
' this code formats the CSwisebuilding list and edits 3634 & 4331 to 3634a and 4331a and adds 241,249,280 and 255 count column
' this code also directly picks up the value mentioned from the filter
    Rows("1:1").Select
    Selection.Delete shift:=xlUp
    Range("A1").Select
    ' this below code is selecting entire sheet even though theres a column or row  gap
    ActiveSheet.UsedRange.Select
    Selection.copy
    Workbooks.Add
    ActiveSheet.Paste
    Application.CutCopyMode = False
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlLTR
        .MergeCells = False
    End With
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlThin
    End With
    Range("A1").Select
    Do Until ActiveCell = ""
    ActiveCell.Offset(1, 0).Select
    Loop
    ActiveCell.EntireRow.Delete
    Columns("C:C").Select
    Selection.TextToColumns Destination:=Range("C1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Range("C1").Select
    Selection.AutoFilter
    ' this below code will select the whole area and filter on criteria
    ' if the column placement changes change the field no. accordingly
    ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:="3634"
    ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:= _
    "Zaitoon Manzil"
    If ActiveSheet.FilterMode = True Then
        'Select first row below heading
        ActiveSheet.UsedRange.SpecialCells _
        (xlCellTypeVisible).Areas(2).Select
    End If
    Cells(Application.ActiveCell.Row, 3).Select
     ActiveCell.FormulaR1C1 = "3634a"
    ActiveSheet.ShowAllData
    ' this below code will select the whole area and filter on criteria
    ' if the column placement changes change the field no. accordingly
    ActiveSheet.UsedRange.AutoFilter Field:=3, Criteria1:="4331"
    ActiveSheet.UsedRange.AutoFilter Field:=4, Criteria1:= _
        "Safiya Manzil"
    If ActiveSheet.FilterMode = True Then
        'Select first row below heading
        ActiveSheet.UsedRange.SpecialCells _
        (xlCellTypeVisible).Areas(2).Select
    End If
    Cells(Application.ActiveCell.Row, 3).Select
    ActiveCell.FormulaR1C1 = "4331a"
    ActiveSheet.ShowAllData
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("B2:B" & Cells(Rows.Count, 1).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Add Key:=Range _
        ("C2:C" & Cells(Rows.Count, 1).End(xlUp).Row), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    ActiveWorkbook.Worksheets("Sheet1").AutoFilter.Sort.SortFields.Clear
'    ---------------------------------------------------------------------------
    Range("A1").Select
    Selection.AutoFilter
    ActiveSheet.UsedRange.Select
     With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlTop
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlLTR
        .MergeCells = False
    End With
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlLTR
        .MergeCells = False
    End With
    Range("O5").Select
    Rows("1:1").RowHeight = 42
    Rows("1:1").Select
    Range("K1").Activate
    With Selection
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    ActiveSheet.UsedRange.Columns.AutoFit
    Columns("D:D").Select
    With Selection
        .HorizontalAlignment = xlLeft
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .MergeCells = False
    End With
    Range("D1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlLTR
        .MergeCells = False
    End With

' from here bldgwise cosde starts merged with above code
'----------------------------------------------------------------------------------------------------------------------
Range("A1").Select
Columns("A:A").insert shift:=xlToRight
Range("A1") = "CS 280"
ActiveCell.Font.Bold = True


'this step will select the cell and put formula in the active cell
Range("A2").Select
Range("A2").Formula = "=IF(OR(D2=""3634a"",D2=""4331a""),"" - "",""CSC"")"
Range("B2").Select

'this loop is to select the cell and go down till the last cell available in the sheet with data
Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, -1).Select

'this will select the above cell
Range(Selection, Selection.End(xlUp)).Select

'this will copy the above cell data down cell
Selection.FillDown

'from here CSWISE BLDGWISE Code Starts
Columns("A:A").insert shift:=xlToRight
Range("A1").Select
Range("A1") = "CSWISE Blgwise"
ActiveCell.Font.Bold = True
ActiveCell.WrapText = True

Range("A2").Select
Range("A2").Formula = "=IF(OR(O2=""Religious Properties"",O2=""MCGM Properties - VLT"",O2=""Already Developed"",E2=""3634a"",E2=""4331a"",),""-"",""CBC"")"
Range("B2").Select

Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, -1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown

'from here BLDGWISE Code Starts

Columns("A:A").insert shift:=xlToRight
Range("A1").Select
Range("A1") = "BLDWISE"
ActiveCell.Font.Bold = True
ActiveCell.WrapText = True

Range("A2").Select
Range("A2").Formula = "=IF(OR(P2=""Religious Properties"",P2=""MCGM Properties - VLT"",P2=""Already Developed"",F2=3603,F2=3615,F2=3648,F2="".1/3652"",F2=4217,F2=4219,F2=4284,F2="".1/4299"",F2=4265,F2=4272),""-"",""BBC"")"
Range("B2").Select

Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, -1).Select
'this code does the job of shift+end+up arrow key of selecting the entire columns till data available in the cell
Range(Selection, Selection.End(xlUp)).Select
'this code copies the data of first cell in the selection and pastes it down
Selection.FillDown

'from here 255 Code Starts

Columns("A:A").insert shift:=xlToRight
Range("A1").Select
Range("A1") = "255 list"
ActiveCell.Font.Bold = True
ActiveCell.WrapText = True

Range("A2").Select
Range("A2").Formula = "=IF(OR(G2="".1/3609"",G2=3601,G2=3606,G2=3607,G2=3608,G2=3609,G2="".1/3673"",G2=3676,G2=3673,G2=4200,G2=4287,G2=3616,G2=4288,Q2=""MCGM Properties - VLT"",Q2=""Already Developed""),""-"",""255"")"
Range("B2").Select

Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, -1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown

'from here CS number Starts

Columns("A:A").insert shift:=xlToRight
Range("A1").Select
Range("A1") = "CS nos."
ActiveCell.Font.Bold = True
ActiveCell.WrapText = True

Range("A2").Select
Range("A2").Formula = "=H2"
Range("B2").Select

Do Until ActiveCell = ""
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, -1).Select
Range(Selection, Selection.End(xlUp)).Select
Selection.FillDown


'this will add numbers to the cell
Columns("A:A").insert shift:=xlToRight
Range("A1").Select
Range("A1") = "Sr. No."
ActiveCell.Font.Bold = True
ActiveCell.WrapText = True

Range("A2") = 1
Range("A3") = 2
Range("A2:A3").AutoFill Destination:=Range("A2:A" & Range("B" & Rows.Count).End(xlUp).Row)

Columns("A:F").HorizontalAlignment = xlCenter
Columns("A:F").VerticalAlignment = xlCenter
Range("A1:F1").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Borders.Color = vbBlack

Range(("I1"), Range("I1").End(xlDown)).Select

Selection.TextToColumns
Range("A1").Select
Application.ScreenUpdating = True
End Sub
 
Last edited by a moderator:

Excel Facts

Format cells as currency
Select range and press Ctrl+Shift+4 to format cells as currency. (Shift 4 is the $ sign).
Sort by date Sort by votes
Hi and welcome,

please use code tags around your code by selecting # Wrap
Code: 
 tags around selected text!
 
Upvote 0
One thing I noticed while doing number of tries is if i dont use these 3 lines code works perfectly
Rows("1:1").Select
Selection.Delete Shift:=xlUp
Range("A1").Select

I use these lines because the downloaded report has a heading in first row which is merged entire row
and below this row is column headers
Using these lines delete the row 1 completely and moves row 1 up which has column headers
i shared this if it helps someone to give me a resolution
 
Upvote 0
You must log in or register to reply here.

Similar threads

A
  • Question Question
Save as dialogue box for excel, but pre populating filename from source word document
Replies
8
Views
282
RoryA
RoryA
J
  • Question Question
VBA removing heading in spreadsheet
Replies
3
Views
273
rlv01
R
K
  • Solved
formating question
Replies
3
Views
324
Micron
M
C
  • Solved
VBA Too Slow
Replies
1
Views
314
Cubist
Cubist
L
  • Locked
  • Question Question
Help Cleaning Up Code
Replies
2
Views
600
RoryA
RoryA

Forum statistics

Threads
1,224,823
Messages
6,181,177
Members
453,021
Latest member
Justyna P

Share this page

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