CODEWITHSUNDEEP
vbaexcel
Laurentiu Mirica
Laurentiu Mirica

Reputation: 135

VBA code crashing Excel if closed early

Hello again and thank you for time !

I have the following code that would not let me work in peace - although I am no VBA power I have managed to put this together in about a week or so. After launching the macro, most of the times I must not touch excel at all for ~2 minutes but I do have occasions for which it closes by itself ...

Sub Filter()
'
' substitute Macro

Application.ScreenUpdating = False
Selection.Copy
ActiveWindow.ActivateNext
Sheets.Add After:=Sheets(Sheets.Count)
ActiveSheet.Name = "buffer"

    Dim wsS As Worksheet, wsN As Worksheet, i As Integer, j As Integer, k As Integer, l As Integer
    Set wsS = Sheets("buffer")
    Set wsN = Sheets("non_confid")

    colA = "A"
    colB = "B"
    colC = "C"
    colE = "E"
    i = 2

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Selection.Replace What:=" ", Replacement:=","
Range("A1").Copy
Range("z1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Columns("A:y").Select
Range("F25").Activate
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft

    Range("B1").FormulaR1C1 = "=SUBSTITUTE(RC[-1],CHAR(13),"";"")"
    Range("C1").FormulaR1C1 = "=SUBSTITUTE(RC[-1],CHAR(10),"";"")"
    Range("D1").FormulaR1C1 = "=substitute(rc[-1],""/"","";"")"
    Range("e1").FormulaR1C1 = "=substitute(rc[-1],""consultant"","";"")"
    Range("f1").FormulaR1C1 = "=substitute(rc[-1],""dessinateur"","";"")"
    Range("g1").FormulaR1C1 = "=substitute(rc[-1],""grp"","";"")"
    Range("h1").FormulaR1C1 = "=substitute(rc[-1],""projet"","";"")"
    Range("i1").FormulaR1C1 = "=substitute(rc[-1],""Inscrire dans ce pavé les projets ou familles concernés"","";"")"
    Range("j1").FormulaR1C1 = "=substitute(rc[-1],""Inscrire dans ce pavé les profils demandés"","";"")"
    Range("k1").FormulaR1C1 = "=substitute(rc[-1],""Droits en consultation"","";"")"
    Range("l1").FormulaR1C1 = "=substitute(rc[-1],""Droits en création"","";"")"
    Range("m1").FormulaR1C1 = "=substitute(rc[-1],"":"","";"")"
    Range("n1").FormulaR1C1 = "=substitute(rc[-1],""("","";"")"
    Range("o1").FormulaR1C1 = "=substitute(rc[-1],"")"","";"")"
    Range("p1").FormulaR1C1 = "=substitute(rc[-1],""profil"","";"")"
    Range("q1").FormulaR1C1 = "=substitute(rc[-1],""non,confid"","";"")"
    Range("r1").FormulaR1C1 = "=substitute(rc[-1],"" "","";"")"

Range("r1").Copy
Range("s2").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp
Columns("A:r").Select
Selection.Delete Shift:=xlToLeft
Range("A1").Select
Selection.TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=True, Tab:=True, Semicolon:=True, Comma:=True, Space:=False, OtherChar:="/", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1), Array(11, 1), Array(12, 1), Array(13, 1), Array(14, 1), Array(15, 1), Array(16, 1), Array(17, 1), Array(18, 1), 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))
Range(Selection, Selection.End(xlToRight)).Copy
Range("A2").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

Columns("A:A").EntireColumn.AutoFit
Rows("1:1").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
Range("a1").FormulaR1C1 = "Sorted"
Range("a1").Select
ActiveSheet.Range("$A$1:$A$300").RemoveDuplicates Columns:=1, Header:=xlNo
ActiveSheet.ListObjects.Add(xlSrcRange, Range("$A$1:$a$500"), , xlYes).Name = "Table1"
ActiveSheet.ListObjects("Table1").Range.AutoFilter Field:=1, Criteria1:="<>"

Range("B2").Select
ActiveCell.FormulaR1C1 = _
    "=IFERROR(IF(ISNA(MATCH([@Sorted],NPDM[Contexte],0)),IF(FIND(""."",[@Sorted]),[@Sorted],""""),""""),"""")"
Range("B1").FormulaR1C1 = "Formula"
Range("Table1[Formula]").Select
Selection.Copy
Range("C2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=False, Transpose:=False
Columns("B:B").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlToLeft
Range("B1").FormulaR1C1 = "Dot"

Range("Table1[Dot]").Select
Selection.TextToColumns Destination:=Range("Table1[[#Headers],[Dot]]"), _
    DataType:=xlDelimited, TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter _
    :=True, Tab:=True, Semicolon:=True, Comma:=True, Space:=False, Other _
    :=True, OtherChar:=".", FieldInfo:=Array(Array(1, 1), Array(2, 1)), _
    TrailingMinusNumbers:=True
Range("C1").FormulaR1C1 = "nDot"
Range("B1").FormulaR1C1 = "Dot"

Range("Table1[Dot]").Select
Selection.Copy
Range("A250").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=True, Transpose:=False
Range("Table1[nDot]").Select
Selection.Copy
Range("A500").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
    :=True, Transpose:=False
Range("B:C").EntireColumn.Delete

    For j = 2 To 300
        If Not IsEmpty(wsS.Range(colA & j).Value) Then
            wsS.Range(colC & i - 1).Value = wsS.Range(colA & j).Value
            i = i + 1
        End If
    Next

Range("A:B").EntireColumn.Delete

    For k = 1 To 300
           If Not IsEmpty(wsS.Range(colA & k).Value) Then
                wsN.Range(colE & i).Value = wsS.Range(colA & k).Value
                i = i + 1
           End If
    Next

Sheets("non_confid").Select
Columns("A:G").EntireColumn.AutoFit
Range("e1").Select
ActiveSheet.ListObjects("Status").Range.AutoFilter Field:=4, Criteria1:="<>"
Range("E2").Select
ActiveWorkbook.Worksheets("non_confid").ListObjects("Status").Sort.SortFields. _
    Clear
ActiveWorkbook.Worksheets("non_confid").ListObjects("Status").Sort.SortFields. _
    Add Key:=Range("Status[ce ?]"), SortOn:=xlSortOnValues, Order:= _
    xlAscending, DataOption:=xlSortNormal

    With ActiveWorkbook.Worksheets("non_confid").ListObjects("Status").Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With

Range("A1").Select
Application.DisplayAlerts = False
Sheets("buffer").Select
ActiveWindow.SelectedSheets.Delete
Application.DisplayAlerts = True
ActiveWorkbook.Saved = True
Application.ScreenUpdating = True
End Sub

PS - since my team mates will be working with this, is there a way for this macro to work on a PC that is in French ? because in an earlier version was not (making "Feuil1" while looking for "Sheet1" and putting formulas in English instead of translating them). As I understood, the macro convert automatically to an universal programming language to be read wherever they are opened.

Upvotes: 0

Views: 769

Answers (2)

Cor_Blimey
Cor_Blimey

Reputation: 3310

For non english languages, you could use .FormulaLocal or .FormulaR1C1Local. Developer reference says "Returns or sets the formula for the object, using R1C1-style notation in the language of the user. Read/write Variant".

However, I strongly recommend not using the above, as it will mean it won't work if the macro is run on a different language version. Instead, better practice is to use English in conjunction with .Formula and .FormulaR1C1. This will still open as French in a French version, as Excel automatically displays formulae text in the relevant language.

For example: (I use "FALSE" only as an example - the below is true for formulae too like "=SUM(A1)", and of course, if you really want to set a boolean value then please don't use string "TRUE"!)

ActiveCell.Formula = "FALSE"

Ok - Locale independent - This will be a FALSE boolean value displayed as FALSE in English and displayed as FAUX in French, but in both cases it is a Boolean value

ActiveCell.FormulaLocal = "FAUX"

'Bad - Locale dependent! - This will be a String "FAUX" if the macro is run on an English version, but a boolean FALSE if run on a French version

ActiveCell.Formula = "FAUX"

'Locale independent, but probably not what you want - This will be a String "FAUX" in all languages

You should not hard-code referring to a sheet by something like "Feuil1". This is just a string name, and Excel will not adapt for the User's locale. Instead, when you add a new sheet, immediately assign it to a worksheet variable, then use that.

For example:

'Bad: it might work if the workbook is made on a French version but it won't on English and vice versa
Worksheets("Feuil1").Activate
Worksheets("Sheet1").Activate 'also bad

'Better:
Worksheets(1).Activate
'or
With Worksheets.Add
.Name = "Results"
.Activate
End With
'or (for use outside a With block)
Set resultsWs = Worksheets.Add

As for the rest - I am afraid I do not know what your question is. It is probably crashing sometimes because you are using lots of cut/copy - if it is a very large worksheet or with lots of formulae that recalculate each cut/insert this will take a long time. Unless you need intermediate calculations, disable calculation and screen updating at the start and only re-enable at the end (using Application.ScreenUpdating = False, and Application.Calculation = XLManual)

Upvotes: 3

David Zemens
David Zemens

Reputation: 53623

Cor_Blimey gave you some great information above. I will add to this.

Your code can probably be improved if you learn to avoid the Select and Activate methods (which force you to rely on bulkier, cumbersome code that takes longer to execute). It also makes for code that is not as easily legible, because it's not as object-oriented.

Also, many people rely unnecessarily on Copy & Paste methods, when that can also usually be avoided.

Here is one such example, where you copy a range and then paste values to another range:

Range("A1").Copy
Range("z1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False

This can be simplified like:

Range("Z1").Value = Range("A1").Value

Here is an example of unnecessary Select method:

Rows("1:1").Select
Application.CutCopyMode = False
Selection.Delete Shift:=xlUp

These three lines of code can be replaced with one statement:

Rows("1:1").EntireRow.Delete

And another (there are several examples of such):

Range("B2").Select
ActiveCell.FormulaR1C1 = _
"=IFERROR(IF(ISNA(MATCH([@Sorted],NPDM[Contexte],0)),IF(FIND(""."",[@Sorted]),[@Sorted],""""),""""),"""")"

In the above, you first select/activate a cell, and then you operate on the ActiveCell. This is unnecessary, you can simply operate on the object directly:

Range("B2").FormulaR1C1 = "=IFERROR(IF(ISNA(MATCH([@Sorted],NPDM[Contexte],0)),IF(FIND(""."",[@Sorted]),[@Sorted],""""),""""),"""")"

THese are some helpful coding practices. Otherwise, @Cor_Blimey's answer above is very good. The Application.ScreenUpdating should speed up the execution time, and if possible, setting Application.Calculation = xlManual will also help. However, the .Calculation method might not be an option in this case, since you may be relying on interim calculations as you're moving .Values from one range to another.

Upvotes: 3

Related Questions