Macro deleting all my data!

[Japonica42]

Hello,

It's AGES since used any macros and even then I only really recorded them and tweaked them. I'm trying to create a macro that formats some data. However when I run it I end up with a completely blank sheet except for a bit of writing and thick box borders - all the data that was in the file has disappeared!!Any ideas why?

 Sub Macro24()
'
' Macro24 Macro
'
'
    Columns("I:J").Select
    Range("I3").Activate
    Selection.Delete Shift:=xlToLeft
    ActiveWindow.SmallScroll Down:=9
    Range("E42:H42").Select
    Selection.ClearContents
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    With Selection
        .HorizontalAlignment = xlGeneral
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    End With
    Selection.UnMerge
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveCell.FormulaR1C1 = "Comments"
    Range("E43:H43").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    ActiveWindow.SmallScroll Down:=21
    Selection.AutoFill Destination:=Range("E43:H919"), Type:=xlFillDefault
    Range("E43:H919").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    Selection.Borders(xlEdgeLeft).LineStyle = xlNone
    Selection.Borders(xlEdgeTop).LineStyle = xlNone
    Selection.Borders(xlEdgeBottom).LineStyle = xlNone
    Selection.Borders(xlEdgeRight).LineStyle = xlNone
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Selection.Borders(xlInsideVertical).LineStyle = xlNone
    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
    ActiveWindow.SmallScroll Down:=-30
    Range("A1:H14").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = 0
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    Rows("16:21").Select
    Selection.Delete Shift:=xlUp
    Range("B8").Select
End Sub

Thanks,
Jenny

 

[Fluff]

Hi & welcome to MrExcel.
Probably due to the merged cells.
Best thing to do is get rid of them permanently, otherwise they will cause you all sorts of problems.

 

[mumps]

Could you explain in words, in detail, referring to specific cells, rows and columns what you are trying to do?

 

[Japonica42]

There is a daily report generated at work (sorry, I can't share that data) - it then needs to be formatted in a standard way - one of those 'it's always been like this' sort of things! I'm just trying to get a macro to do it to save some time and effort. The first thing I do is delete column I and J then rows 16-21 inclusive. Then I delete the text that is already in cells E42, F42, G42 and H42 and merge the cells together and write in 'Comments'. Then merge cells E43, F43, G43 and H43 an drag that down to row 1419 before clearing any borders and then put a thick outer border around the outside of that whole selection. I finish off by putting a thick box border around A1 - H14.
It is worth noting that I have tried just recording on of these steps and still end up with a blank spread sheet!

 

[RoryA]

See if this works better:

 Sub Macro24()
'
' Macro24 Macro
'
'
    Columns("I:J").Delete Shift:=xlToLeft
    With Range("E42:H42")
        .ClearContents
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = True
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
    .Value = "Comments"
    End With
    With Range("E43:H43")
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlBottom
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = True
        .AutoFill Destination:=Range("E43:H919"), Type:=xlFillDefault
    End With
    
    With Range("E43:H919")
    .Borders.LineStyle = xlNone
    .BorderAround xlContinuous, xlMedium, 0
    End With
    Rows("16:21").Delete Shift:=xlUp
    Range("B8").Select
End Sub

 

[Japonica42]

Awesome - thank you Rory - What was I doing wrong?

Thanks,
Jenny

 

[RoryA]

I suspect, as others mentioned, that merged cells were the issue. Using Select in your code would mean that when you tried to select columns I:J, if there were merged cells in there spanning other columns, those would also be selected. Another reason to avoid selecting things in code - it's rarely necessary.