The output after running the vba code gets deleted, not every time but every alternative time

Question

I have a question as I am puzzled with how code acts. If I run the below code, sometimes, the input in the 'raw' sheet gets deleted completed. If I re-start xls and run the code using the same (!) input in the raw sheet, it runs just fine. Do you have an idea, what's the reason for it as I am totally clueless? And how could I resolve it?

Many thanks, Eka

Sub dataset_transformation()

    Dim irow As Long
    Dim icol As Integer
    Dim lastRw As Long

    On Error Resume Next

'Deleting empty rows
'Columns("A:A").SpecialCells(xlCellTypeBlanks).EntireRow.Delete
'Columns("B:B").SpecialCells(xlCellTypeBlanks).EntireRow.Delete

    'Deleting the temp sheet on the workbook (in case it exists)
    Application.DisplayAlerts = False
    For Each Sheet In ActiveWorkbook.Worksheets
        If Sheet.Name = "interim" Then
            Sheet.Delete
        End If
    Next Sheet

    'Adding the brand new working sheets
    Sheets.Add After:=Sheets("raw")
    ActiveSheet.Name = "interim"

    Sheets("raw").Select
    'Loop through rows - Bottom to top
    For irow = Cells.SpecialCells(xlLastCell).Row To 2 Step -1
        'Loop Through Columns right to left
        For icol = Cells.SpecialCells(xlLastCell).Column To 1 Step -1
            'If Cell is Bold - Do Nothing
            If Cells(irow, icol).Font.FontStyle = "Bold" Then
            'If Cell is Normal and Not empty - Do nothing
            ElseIf Cells(irow, icol).Font.FontStyle = "Regular" And Not IsEmpty(Cells(irow, icol)) Then
            'Otherwise - Delete row
            Else
                Cells(irow, icol).EntireRow.Delete
                'Exit Loop
                Exit For
            End If
        Next icol
    Next irow

    'Removing the extra space in the amount column
    'Range("B1:D" & Cells(Rows.Count, 1).End(xlUp).Row).Replace What:=".", Replacement:=",", SearchOrder:=xlByColumns
    Range("B1:D" & Cells(Rows.Count, 1).End(xlUp).Row).Replace What:=" ", Replacement:="", SearchOrder:=xlByColumns
    Rows("1:2").Select
    Range("A2").Activate
    Selection.Delete Shift:=xlUp

    'Converting count & sum columns to numbers
    Columns("B:B").Select
    'Range("B226").Activate
    Selection.TextToColumns Destination:=Range("B1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True
    Columns("D:D").Select
    'Range("D226").Activate
    Selection.TextToColumns Destination:=Range("D1"), DataType:=xlDelimited, _
        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
        Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
        :=Array(1, 1), TrailingMinusNumbers:=True

    'Identifying the intend level
    'Dim CurCell As Range
    'Set CurCell = ActiveCell
    Cells(2, 1).Select
    Do While Trim(ActiveCell.Value) <> ""
        ActiveCell.Offset(0, 4).Value = ActiveCell.IndentLevel
        ActiveCell.Offset(1, 0).Select
    Loop

    'Copying the Ylan-Yde data to a new sheet
    Columns("A:A").Select
    Selection.Find("??????? ATLAS ????-???", LookIn:=xlValues).Select
    Range(ActiveCell.Address & ":" & Cells(Cells(Rows.Count, "A").End(xlUp).Row, ActiveCell.Column + 4).Address).Select
    Selection.Copy
    'Pasting the Ylan-Yde data to the new sheet
    Sheets("interim").Select
    Range("A1").Select
    ActiveSheet.Paste

    'Creating the column which says whether it is a main shop or Ylan-Yde
    'Main shop
    Sheets("raw").Select
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("B3").Select
    Selection.Copy
    Range("A1").Select
    ActiveSheet.Paste
    Selection.AutoFill Destination:=Range("A1:A" & Range("B" & Rows.Count).End(xlUp).Row)
    'Ylan-Yde
    Sheets("interim").Select
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight
    Range("B1").Select
    Selection.Copy
    Range("A1").Select
    ActiveSheet.Paste
    Selection.AutoFill Destination:=Range("A1:A" & Range("B" & Rows.Count).End(xlUp).Row)

    'Deleting the Ylan-Yde data from the Atlas data
    Sheets("raw").Select
    Columns("B:B").Select
    Selection.Find("??????? ATLAS ????-???", LookIn:=xlValues).Select
    Rows(ActiveCell.Row & ":" & Rows.Count).Delete

    'Deleting the total sum row
    Sheets("interim").Select
    ActiveSheet.Cells(Rows.Count, "A").End(xlUp).EntireRow.Delete

    'Calculating the % contribution to total - main shop sheet
    Sheets("raw").Select
    Range("G3").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/R3C5"
    Selection.AutoFill Destination:=Range("G3:G" & Range("A" & Rows.Count).End(xlUp).Row)
    ActiveSheet.Columns("G").Copy
    ActiveSheet.Columns("G").PasteSpecial xlPasteValues

    'Calculating the % contribution to total - Ylan-Yde sheet
    Sheets("interim").Select
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "=RC[-2]/R1C5"
    Selection.AutoFill Destination:=Range("G1:G" & Range("A" & Rows.Count).End(xlUp).Row)
    ActiveSheet.Columns("G").Copy
    ActiveSheet.Columns("G").PasteSpecial xlPasteValues

    'Copying the Yland-Yde data back to the main shop data
    Range("A1:G" & Cells(Rows.Count, "A").End(xlUp).Row).Select
    Selection.Copy
    Sheets("raw").Select
    lastRw = Cells(Rows.Count, "A").End(xlUp).Row
    Range("A" & lastRw + 1).Select
    ActiveSheet.Paste

    'Naming the newly created cols
    Range("A1").Value = "M"
    Range("A2").Value = ""
    Range("F1").Value = "L"
    Range("F2").Value = ""
    Range("G1").Value = "%"
    Range("G2").Value = ""
    Range("B1").Select
    Selection.Copy
    Range("A1:A2").Select
    Range("A2").Activate
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("B1").Select
    Selection.Copy
    Range("F1:G2").Select
    Range("G2").Activate
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False

    'Changing the format of the % contribution to %
    Columns("G:G").Select
    Selection.Style = "Percent"
    Selection.NumberFormat = "0.00%"

    'Adding the blue background
    Range(Cells(1, "G"), Cells(Cells(Rows.Count, 1).End(xlUp).Row, "F")).Select
    With Selection.Interior
        .PatternColorIndex = xlAutomatic
        .Color = 16777200
        .TintAndShade = 0
        .PatternTintAndShade = 0
    End With

    'Adding the table borders
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ThemeColor = 9
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ThemeColor = 9
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ThemeColor = 9
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ThemeColor = 9
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ThemeColor = 9
        .TintAndShade = 0
        .Weight = xlThin
    End With
    With Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .ThemeColor = 9
        .TintAndShade = 0
        .Weight = xlThin
    End With

    'Deleting the interim sheet
    Sheets("interim").Select
    Application.DisplayAlerts = False
    ActiveWindow.SelectedSheets.Delete

    MsgBox "Whoop, whoop, that's all folks!"


End Sub

Answer 1

I recommend making a copy of your workbook before testing the code below. I don't think I broke anything or changed anything major, but who knows.

• Always make references to workbooks and worksheets explicit. This means you should refer to them by name (or full file path if applicable). Otherwise, all cells/ranges will relate to whatever workbook and worksheet happens to be active (whilst the code is running).
• If you're going to be referring to certain worksheets throughout your code, store them in a variable at the start (then refer to the variable).
• Strongly recommend putting Option Explicit before your code.

The code below assumes your interim and raw worksheets are in the same workbook that your VBA code is in.

Option Explicit

Sub DataSetTransformation()

    ' Assumes "raw" and "interim" sheets are in the same workbook that your VBA code is in.
    With ThisWorkbook ' If this is not true, refer to the workbook by name.
        Dim rawSheet As Worksheet
        Set rawSheet = .Worksheets("raw")

        Dim interimSheet As Worksheet
        On Error Resume Next
        Set interimSheet = .Worksheets("interim")
        On Error GoTo 0

        If Not (interimSheet Is Nothing) Then
            Application.DisplayAlerts = False
            interimSheet.Delete
            Application.DisplayAlerts = True
        End If

        Set interimSheet = .Worksheets.Add(After:=rawSheet)
        interimSheet.Name = "interim"
    End With

    Dim rowIndex As Long
    Dim columnIndex As Long

    With rawSheet
        For rowIndex = .Cells.SpecialCells(xlLastCell).Row To 2 Step -1
            For columnIndex = .Cells.SpecialCells(xlLastCell).Column To 1 Step -1
                With .Cells(rowIndex, columnIndex)
                    If (.Font.FontStyle <> "Bold") And Not (.Font.FontStyle = "Regular" And Not IsEmpty(.Value2)) Then
                        .EntireRow.Delete
                        Exit For ' I think you want to exit the loop early here (to return to column 1).
                    End If
                End With
            Next columnIndex
        Next rowIndex
    End With

    'Removing the extra space in the amount column
    With rawSheet
        .Range("B1:D" & .Cells(.Rows.Count, 1).End(xlUp).Row).Replace What:=" ", Replacement:="", SearchOrder:=xlByColumns
        .Rows("1:2").Delete Shift:=xlUp

        'Converting count & sum columns to numbers
        .Columns("B:B").TextToColumns Destination:=.Range("B1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True
        .Columns("D:D").TextToColumns Destination:=.Range("D1"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, _
            Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo _
            :=Array(1, 1), TrailingMinusNumbers:=True

        'Identifying the indent level
        rowIndex = 2
        Do While Trim(.Cells(rowIndex, "A")) <> ""
            .Cells(rowIndex, "A").Offset(0, 4).Value = .Cells(rowIndex, "A").IndentLevel
            rowIndex = rowIndex + 1
        Loop

        Dim cellFound As Range
        Set cellFound = .Columns("A:A").Find("??????? ATLAS ????-???", LookIn:=xlValues)

        With cellFound
            ' Always check if Range.Find found anything (even though I don't do this below); otherwise you will get an error when it didn't.
            ' Also, seems like you should be using Range.AutoFilter for this operation -- and copy-pasting all cells that are returned by the filter.

            'Copying the Ylan-Yde data to a new sheet, pasting the Ylan-Yde data to the new sheet
            .Range(cellFound, .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row, cellFound.Column + 4)).Copy interimSheet.Range("A1")
        End With

        'Creating the column which says whether it is a main shop or Ylan-Yde
        'Main shop
        .Columns("A:A").Insert Shift:=xlToRight
        .Range("B3").Copy .Range("A1")
        .Range("A1").AutoFill Destination:=.Range("A1:A" & .Range("B" & .Rows.Count).End(xlUp).Row)
    End With


    'Ylan-Yde
    With interimSheet
        .Columns("A:A").Insert Shift:=xlToRight
        .Range("B1").Copy .Range("A1")
        .Range("A1").AutoFill Destination:=.Range("A1:A" & .Range("B" & Rows.Count).End(xlUp).Row)
    End With

    'Deleting the Ylan-Yde data from the Atlas data
    With rawSheet
        ' Again, seems like you should be using Range.AutoFilter for this.
        Set cellFound = .Columns("B:B").Find("??????? ATLAS ????-???", LookIn:=xlValues)
        .Rows(cellFound.Row & ":" & .Rows.Count).Delete
    End With

    'Deleting the total sum row
    With interimSheet
        .Cells(.Rows.Count, "A").End(xlUp).EntireRow.Delete
    End With

    'Calculating the % contribution to total - main shop sheet
    With rawSheet
        .Range("G3:G" & .Range("A" & .Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[-2]/R3C5"
        .Columns("G").Value2 = .Columns("G").Value2
    End With

    'Calculating the % contribution to total - Ylan-Yde sheet
    With interimSheet
        .Range("G1:G" & .Range("A" & .Rows.Count).End(xlUp).Row).FormulaR1C1 = "=RC[-2]/R1C5"
        .Columns("G").Value2 = .Columns("G").Value2

        Dim lastRw As Long
        'Copying the Yland-Yde data back to the main shop data
        .Range("A1:G" & Cells(.Rows.Count, "A").End(xlUp).Row).Copy
    End With

    With rawSheet
        .Cells(.Cells(.Rows.Count, "A").End(xlUp).Row + 1, "A").PasteSpecial xlPasteAll

        'Naming the newly created cols
        .Range("A1").Value = "M"
        .Range("A2").Value = ""
        .Range("F1").Value = "L"
        .Range("F2").Value = ""
        .Range("G1").Value = "%"
        .Range("G2").Value = ""
        .Range("B1").Copy
        .Range("A1:A2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False

        .Range("B1").Copy
        .Range("F1:G2").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
            SkipBlanks:=False, Transpose:=False
        Application.CutCopyMode = False

        'Changing the format of the % contribution to %
        With .Columns("G:G")
            .Style = "Percent"
            .NumberFormat = "0.00%"
        End With

        'Adding the blue background
        With .Range("G1", .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, "F"))
            With .Interior
                .PatternColorIndex = xlAutomatic
                .Color = 16777200
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With

            .Borders(xlDiagonalDown).LineStyle = xlNone
            .Borders(xlDiagonalUp).LineStyle = xlNone

            'Adding the table borders
            Dim bordersToChange As Variant
            bordersToChange = Array(xlEdgeLeft, xlEdgeTop, xlEdgeBottom, xlEdgeRight, xlInsideVertical, xlInsideHorizontal)

            ' You repeat yourself a lot when applying border styles. Maybe something like the below is effectively the same, but easier to maintain.
            For rowIndex = LBound(bordersToChange) To UBound(bordersToChange)
                With .Borders(bordersToChange(rowIndex))
                    .LineStyle = xlContinuous
                    .ThemeColor = 9
                    .TintAndShade = 0
                    .Weight = xlThin
                End With
            Next rowIndex
        End With

    End With

    'Deleting the interim sheet
    Application.DisplayAlerts = False
    interimSheet.Delete
    Application.DisplayAlerts = True

    MsgBox "Whoop, whoop, that's all folks!"

End Sub

It is generally better to break larger/longer procedures into a smaller/shorter procedures.