Deleting temporary rows and columns from 21-sheet workbook

Question

I've created a VBA code to delete extra rows and columns that were needed for initial calculations but are required to be removed before converting/importing a csv into a database. The code loops through 21 sheets and runs for about 4 minutes. Is this a decent run time or can it be shortened?

Public Sub Test()
Dim xWs As Worksheet
Set xWs = ActiveSheet
Dim Firstrow As Long
Dim Lastrow As Long
Dim Lrow As Long
Dim CalcMode As Long
Dim ViewMode As Long
'SETTING DEPENDENT VALUES TO ABSOLUTE VALUES============================='
For Each xWs In Application.ActiveWorkbook.Worksheets
 xWs.Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 xWs.DisplayPageBreaks = False
 xWs.UsedRange.Value = xWs.UsedRange.Value
Next
'DELETING ROWS BASED ON COLUMN B VALUES=================================='
For Each xWs In Application.ActiveWorkbook.Worksheets
 xWs.Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 xWs.DisplayPageBreaks = False
 Firstrow = xWs.UsedRange.Cells(1).Row
 Lastrow = xWs.UsedRange.Rows(xWs.UsedRange.Rows.count).Row
 For Lrow = Lastrow To Firstrow Step -1
 With xWs.Cells(Lrow, "B")
 If Not IsError(.Value) Then
 If .Value = "0" Then .EntireRow.Delete
 End If
 End With
 Next Lrow
Next
'DELETING DUPLICATE IP ADDRESSES=========================================='
With Sheets("IP-Unassigned")
 .Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 .DisplayPageBreaks = False
 Firstrow = .UsedRange.Cells(1).Row
 Lastrow = .UsedRange.Rows(.UsedRange.Rows.count).Row
 For Lrow = Lastrow To Firstrow Step -1
 With .Cells(Lrow, "H")
 If Not IsError(.Value) Then
 If .Value = "1" Then .EntireRow.Delete
 End If
 End With
 Next Lrow
End With
'DELETING EXTRA COLUMNS========================================================'
With Sheets("IP-FSW")
 .Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 .DisplayPageBreaks = False
 Columns(8).EntireColumn.Delete
 Columns(7).EntireColumn.Delete
End With
With Sheets("IP-2070")
 .Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 .DisplayPageBreaks = False
 Columns(8).EntireColumn.Delete
 Columns(7).EntireColumn.Delete
End With
With Sheets("IP-MNTR")
 .Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 .DisplayPageBreaks = False
 Columns(8).EntireColumn.Delete
 Columns(7).EntireColumn.Delete
End With
With Sheets("IP-BBS")
 .Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 .DisplayPageBreaks = False
 Columns(8).EntireColumn.Delete
 Columns(7).EntireColumn.Delete
End With
With Sheets("IP-DET")
 .Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 .DisplayPageBreaks = False
 Columns(8).EntireColumn.Delete
 Columns(7).EntireColumn.Delete
End With
With Sheets("IP-TTR")
 .Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 .DisplayPageBreaks = False
 Columns(8).EntireColumn.Delete
 Columns(7).EntireColumn.Delete
End With
With Sheets("IP-CCTV")
 .Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 .DisplayPageBreaks = False
 Columns(8).EntireColumn.Delete
 Columns(7).EntireColumn.Delete
End With
With Sheets("IP-Unassigned")
 .Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 .DisplayPageBreaks = False
 Columns(16).EntireColumn.Delete
 Columns(15).EntireColumn.Delete
 Columns(14).EntireColumn.Delete
 Columns(13).EntireColumn.Delete
 Columns(12).EntireColumn.Delete
 Columns(11).EntireColumn.Delete
 Columns(10).EntireColumn.Delete
 Columns(9).EntireColumn.Delete
 Columns(8).EntireColumn.Delete
End With
'=========================================================================='
End Sub

• Automate This: Avoid Active or Select statements at all cost. Turn off calculations and screen updating. You should see a big improvement with just doing these three things.

Answer 1

Portland Runner gave some good hints in the comments. Your selection and view changes do not add any value to what you want to achieve. I was able to remove all of them without issues. When doing macro-based Excel manipulation, you should always consider:

• Setting Application.ScreenUpdating to False
• Setting Application.Calculation to xlManual
• Setting Application.EnableEvents to False
• Resetting all of these values when you have completed the work

Of course, there will be exceptions, but these should be rare.

Always remember Option Explicit in VBA

Looking at absolute values:

For Each xWs In Application.ActiveWorkbook.Worksheets
 xWs.Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 xWs.DisplayPageBreaks = False
 xWs.UsedRange.Value = xWs.UsedRange.Value
Next

This can simply be:

For Each xWs In Application.ActiveWorkbook.Worksheets
 xWs.UsedRange.Value = xWs.UsedRange.Value
Next

Cleaner, easier to see what it does, and easier to maintain.

Looking at Column B conditionals:

For Each xWs In Application.ActiveWorkbook.Worksheets
 xWs.Select
 ViewMode = ActiveWindow.View
 ActiveWindow.View = xlNormalView
 xWs.DisplayPageBreaks = False
 Firstrow = xWs.UsedRange.Cells(1).Row
 Lastrow = xWs.UsedRange.Rows(xWs.UsedRange.Rows.count).Row
 For Lrow = Lastrow To Firstrow Step -1
 With xWs.Cells(Lrow, "B")
 If Not IsError(.Value) Then
 If .Value = "0" Then .EntireRow.Delete
 End If
 End With
 Next Lrow
Next

Can become:

For Each xWs In Application.ActiveWorkbook.Worksheets
 Firstrow = xWs.UsedRange.Cells(1).Row
 Lastrow = xWs.UsedRange.Rows(xWs.UsedRange.Rows.count).Row
 For Lrow = Lastrow To Firstrow Step -1
 With xWs.Cells(Lrow, "B")
 If Not IsError(.Value) Then
 If .Value = "0" Then .EntireRow.Delete
 End If
 End With
 Next Lrow
Next

But I see repetition here. You can save your self a small loop. Admittedly, in the example you gave not a big issue but still a good practice to have.

Combining the loops - take note of the order in which I have done this. Do the most work first, and then do the simple clean-up. You could do it the other way (unless the xlError gets converted to a value on the way through?) but considering how much work is done in each step and how each step impacts on the amount of future work is a good habit.

For Each xWs In Application.ActiveWorkbook.Worksheets
 Firstrow = xWs.UsedRange.Cells(1).Row
 Lastrow = xWs.UsedRange.Rows(xWs.UsedRange.Rows.count).Row ' this is yet another different way I have seen to get the last row!
 For Lrow = Lastrow To Firstrow Step -1 ' Good that you know to go backwards.
 With xWs.Cells(Lrow, "B")
 If Not IsError(.Value) Then
 If .Value = "0" Then .EntireRow.Delete
 End If
 End With
 Next Lrow
 xWs.UsedRange.Value = xWs.UsedRange.Value ' Good that you know the simple way to convert formulas to values.
Next

Deleting extra columns - I see a lot of repetition here, and room for a subroutine.

Private Sub Delete78(xWs as Worksheet) 'Sheet could also include a Chart sheet
 xWS.Columns(8).EntireColumn.Delete
 xWS.Columns(7).EntireColumn.Delete
End Sub

Interestingly, you could also do Col7.Del, and then Col7.Del again to achieve the same effect! But at least the way you have written it shows the intent to remove the two columns.

You main part of the code then becomes:

Delete78 Sheets("IP-FSW")
Delete78 Sheets("IP-2070")
Delete78 Sheets("IP-MNTR")
Delete78 Sheets("IP-BBS")
Delete78 Sheets("IP-DET")
Delete78 Sheets("IP-TTR")
Delete78 Sheets("IP-CCTV")

Still some repetition - and this could be fixed as well. But that can be another day. Or perhaps now. Because your last code block seems different but is really the same. So let us try a new subroutine.

Private Sub DeleteColumnBlock(xWs as Worksheet, LastColumn as Long, FirstColumn as Long) ' Get the user to enter the values in a logical order. I chose this way.
 Dim ColIterator as Long
 ' Do some input validation. If they have entered bad values, fix it.
 For ColIterator = LastColumn to FirstColumn Step -1
 xWs.Columns(ColIterator).EntireColumn.Delete
 Next ColIterator
End Sub

Because we are dealing with a contiguous block, you could also do the slightly more obscure - same effect, but slightly harder to see at a glance what you intend to do. Add some good comments if you intend to do this!

For ColIterator = FirstColumn to LastColumn
 xWs.Columns(FirstColumn).EntireColumn.Delete ' continually remove a column until the right number have been removed.
Next ColIterator

Your main part of that entire block then becomes:

DeleteColumnBlock Sheets("IP-FSW"), 8, 7
DeleteColumnBlock Sheets("IP-2070"), 8, 7
DeleteColumnBlock Sheets("IP-MNTR"), 8, 7
DeleteColumnBlock Sheets("IP-BBS"), 8, 7
DeleteColumnBlock Sheets("IP-DET"), 8, 7
DeleteColumnBlock Sheets("IP-TTR"), 8, 7
DeleteColumnBlock Sheets("IP-CCTV"), 8, 7
DeleteColumnBlock Sheets("IP-Unassigned"), 16, 8

Summary

• Turn off the parts of Excel that you don't need when doing grunt work.
• Try to run through a loop only once, don't repeat your loops
  unless it is really really necessary.
• DRY (don't repeat yourself) - repetition is a sign that you can modularise some code making it easier to maintain.
• Use explicit addressing, avoid Active and Select unless there is no other way (e.g. copying sheets to a new workbook is a subroutine, not a function so ActiveWorkbook is the only way to immediately reference that new workbook).
• -- If you do Activate or Select, make sure your following code is actually using those elements.
• -- And then consider if you can already reference it explicitly and do so!

Addendum

In my examples above, I provided a very mechanistic way of deleting columns (based on the OP code). Two more ways to do this without using a loop are to set a range:

• e.g. xWS.Range(xWS.Cells(1,7), xWS.Cells(1,8).EntireColumn.Delete
• Setting a union of the columns, and then deleting

Answer 2

In the code bellow

• Condensed the OP code
• Stopped ScreenUpdating and Events
• Replaced row-by-row deletion in loops with bulk-deletion in AutoFilters

---

Option Explicit
Public Sub RemoveTmpData()
 Const WS_2COLS = "|IP-FSW|IP-2070|IP-MNTR|IP-BBS|IP-DET|IP-TTR|IP-CCTV|"
 Dim ws As Worksheet
 Application.ScreenUpdating = False
 Application.EnableEvents = False
 For Each ws In ThisWorkbook.Worksheets
 ws.DisplayPageBreaks = False
 ws.UsedRange.Value2 = ws.UsedRange.Value2 'convert formulas to values
 If InStr(WS_2COLS, "|" & ws.Name & "|") > 0 Then ws.Columns("G:H").Delete
 RemoveTmpRows ws.UsedRange, 2, 0 'remove rows with val 0, in col B
 Next
 With ThisWorkbook.Worksheets("IP-Unassigned")
 RemoveTmpRows .UsedRange, 8, 1 'remove rows with val 1, in col H
 .UsedRange.Columns("H:P").Delete
 End With
 Application.ScreenUpdating = True
 Application.EnableEvents = True
End Sub
Private Sub RemoveTmpRows(ByRef rng As Range, ByVal colId As Long, ByVal crit As String)
 With rng
 .AutoFilter Field:=colId, Criteria1:=crit
 If .Columns(colId).SpecialCells(xlCellTypeVisible).CountLarge > 1 Then
 .Rows(1).Hidden = True
 .SpecialCells(xlCellTypeVisible).EntireRow.Delete
 .Rows(1).Hidden = False
 End If
 .AutoFilter
 End With
End Sub

---