My code works, but Excel stops responding. No erros mgs from the code

Question

I need some help to make my conde much simpler. I'm starting to code on VBA and build my own scripts and they work properly, sometimes. But they are always tooooo big and much more complicated than it could be.

This is one case that everytime I run the script, Excel crashes. Can someone assist me in making this code much more simple?

    Sub Cleaning_Mirexs()

    Application.ScreenUpdating = False

    Dim UltCel As Range
    Dim Mirex As String
    Dim Glip As String

Mirex = "S"
Glip = "UP"

Set UltCel = Cells(Rows.Count, 2).End(xlUp)

' Moving Data for treatment

    Range("R2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("X2").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Application.CutCopyMode = False
    Selection.TextToColumns Destination:=Range("X2"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
        :="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

' Mirex Formicide Data

Range("$Y2").Select

    Do While ActiveCell <> UltCel
    If InStr(1, ActiveCell.Text, Mirex) Then
    ActiveCell.FormulaR1C1 = ""
    ActiveCell.Offset(0, -1).Select
    ActiveCell.Clear
    ActiveCell.FormulaR1C1 = "IS FORMICIDA MIREX-S" & ActiveCell.Value
    ActiveCell.Offset(1, 1).Select

    ElseIf ActiveCell.Offset(xlDown) Then

    End If

    Loop

' Glip Herbicide Data

Range("Y2").Select

    Do While ActiveCell <> UltCel
    If InStr(1, ActiveCell.Text, Glip) Then
    ActiveCell.Formula = ""
    ActiveCell.Offset(0, -1).Select
    ActiveCell.Clear
    ActiveCell.FormulaR1C1 = "HB GLIP-UP" & ActiveCell.Value
    ActiveCell.Offset(1, 1).Select

    ElseIf ActiveCell.Offset(1, 0).Select Then

    End If

    Loop

' Light Tractor Data
Range("X2").Select

    Do While ActiveCell <> UltCel
    If InStr(1, ActiveCell.Text, "Tratores leves") Then
    ActiveCell.Clear
    ActiveCell.FormulaR1C1 = "Tratores leves" & ActiveCell.Value
    ActiveCell.Offset(1, 0).Select

    ElseIf ActiveCell.Offset(1, 0).Select Then

    End If

    Loop

' Heavy Tractor Data
Range("X2").Select

    Do While ActiveCell <> UltCel
    If InStr(1, ActiveCell.Text, "Tratores pesados") Then
    ActiveCell.Clear
    ActiveCell.FormulaR1C1 = "Tratores pesados" & ActiveCell.Value
    ActiveCell.Offset(1, 0).Select

    ElseIf ActiveCell.Offset(1, 0).Select Then

    End If

    Loop

' back to original place after data treatment
Range("X2").Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.Copy
    Range("X2").Select
    Selection.PasteSpecial Paste:=xlPasteValues


Application.ScreenUpdating = True

MsgBox "Success!"

End Sub

I would like the code to run everything at once, but they way I wrote the script, feels like, a individual run for each data set.

Well, here it is! Let's have fun :)

Thank you!

Maria

Answer 1

Okay, I took a stab at trying to fix this up, but I have several questions about what you're trying to accomplish here... For example:

ActiveCell.Clear
ActiveCell.FormulaR1C1 = "Tratores pesados" & ActiveCell.Value

Here you're just clearing your ActiveCell, then adding some text followed by the ActiveCell.Value which is now nothing, since you just cleared it. I'm not sure what your intent is there.

You also have

ElseIf ActiveCell.Offset(1, 0).Select Then
End If

Which I don't think has ANY functionality, and I'm confused just trying to understand why this would be necessary so I omitted it.

I've also gotten rid of your Do/Loops and replaced them with For loops, which are much more reliable. I've also gotten rid of Select/Activate for the most part, as those are inefficient.

I've also changed UltCel to a Long for the For loops.

If anyone else wants to edit this go right ahead, I'm sure there's something I've missed (like I'm not sure about the .TextToColumns bit:

Sub Cleaning_Mirexs()

Application.ScreenUpdating = False

Dim UltCel As Long
Dim Mirex As String, Glip As String
Dim i As Long

Mirex = "S"
Glip = "UP"

UltCel = Cells(Rows.Count, 2).End(xlUp)

'Moving Data for treatment
Range("X2:X" & UltCel).Value = Range("R2:R" & UltCel).Value
Range("X2:X" & UltCel).TextToColumns Destination:=Range("X2"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="-", FieldInfo:=Array(Array(1, 1), Array(2, 1)), TrailingMinusNumbers:=True

For i = 2 To UltCel
    If InStr(Range("X" & i).Value, Mirex) Then
        Range("X" & i).Value1 = "IS FORMICIDA MIREX-S"
    ElseIf InStr(Range("X" & i).Value, Glip) Then
        Range("X" & i).Value = "HB GLIP-UP"
    ElseIf InStr(Range("X" & i).Value, "Tratores leves") Then
        Range("X" & i).Value = "Tratores leves"
    ElseIf InStr(Range("X" & i).Value, "Tratores pesados") Then
        Range("X" & i).Value = "Tratores pesados"
    End If
Next i

For i = 2 To UltCel
    If InStr(Range("Y" & i).Value, Mirex) Then
        Range("Y" & i).Value1 = "IS FORMICIDA MIREX-S"
    ElseIf InStr(Range("Y" & i).Value, Glip) Then
        Range("Y" & i).Value = "HB GLIP-UP"
    ElseIf InStr(Range("Y" & i).Value, "Tratores leves") Then
        Range("Y" & i).Value = "Tratores leves"
    ElseIf InStr(Range("Y" & i).Value, "Tratores pesados") Then
        Range("Y" & i).Value = "Tratores pesados"
    End If
Next i

'back to original place after data treatment
Range("X2:X" & UltCel).Value = Range("X2:X" & UltCel).Value
Range("Y2:Y" & UltCel).Value = Range("Y2:Y" & UltCel).Value

Application.ScreenUpdating = True

MsgBox "Success!"

End Sub