Reputation: 15
Working Environment: Excel 2013
Target: Delete the unnecessary columns by filtering the content in row 2.
My idea is that as long as the content in row 2 is either
Physical Location
or PLC Tag Name
or Test Step1/2/3/4/5/6/7
, keep those columns, otherwise delete it.
My problem is that I need to run this macro multiple times to delete all the unnecessary columns. It should loop from 1 to 40, and just leave the columns that I want. I am not sure why it doesn't work. Can anyone help me? Thanks!
My code:
Sub Reorder()
Rows(1).Insert shift:=xlShiftDown
For i = 1 To 40
WY = Worksheets("Sheet4").Cells(2, i)
Select Case WY
Case "Physical Location"
Worksheets("Sheet4").Cells(1, i) = 1
Case "PLC Tag Name"
Worksheets("Sheet4").Cells(1, i) = 1
Case "Test Step1"
Worksheets("Sheet4").Cells(1, i) = 1
Case "Test Step2"
Worksheets("Sheet4").Cells(1, i) = 1
Case "Test Step3"
Worksheets("Sheet4").Cells(1, i) = 1
Case "Test Step4"
Worksheets("Sheet4").Cells(1, i) = 1
Case "Test Step5"
Worksheets("Sheet4").Cells(1, i) = 1
Case "Test Step6"
Worksheets("Sheet4").Cells(1, i) = 1
Case "Test Step7"
Worksheets("Sheet4").Cells(1, i) = 1
Case Else
Worksheets("Sheet4").Cells(1, i) = 0
End Select
Next i
For i = 1 To 40
If Worksheets("Sheet4").Cells(1, i) = 0 Then
Columns(i).EntireColumn.Delete
End If
Next
End Sub
Upvotes: 1
Views: 410
Reputation: 57683
If you delete rows in a loop, you need to start from the bottom. Otherwise the row number of the rows below the actual deleted row decrease by one and i
gets increased by one (from the loop), so in sum you miss a line.
instead of
For i = 1 To 40
use
For i = 40 To 1 Step -1
If Worksheets("Sheet4").Cells(1, i) = 0 Then
Columns(i).EntireColumn.Delete
End If
Next
to loop backwards.
Side note: (thx to @A.S.H)
You should use full qualified ranges/cells/rows/columns and never assume the worksheet. Also declare all your variables using option explicit.
Therefore
Rows(1).Insert shift:=xlShiftDown
'...
Columns(i).EntireColumn.Delete
should be
Worksheets("Sheet4").Rows(1).Insert shift:=xlShiftDown
'...
Worksheets("Sheet4").Columns(i).EntireColumn.Delete
So in sum we end up at
Option Explicit 'first line in module
Public Sub Reorder()
Dim i As Long
Dim WY As Worksheet
Set WY = Worksheets("Sheet4")
WY.Rows(1).Insert shift:=xlShiftDown
For i = 1 To 40
Select Case WY.Cells(2, i)
Case "Physical Location", "PLC Tag Name", "Test Step1", "Test Step2", _
"Test Step3", "Test Step4", "Test Step5", "Test Step6", "Test Step7"
WY.Cells(1, i) = 1
Case Else
WY.Cells(1, i) = 0
End Select
Next i
For i = 40 To 1 Step -1
If WY.Cells(1, i) = 0 Then
WY.Columns(i).EntireColumn.Delete
End If
Next
End Sub
Or if we use only one loop which is a lot faster:
Option Explicit 'first line in module
Public Sub Reorder()
Dim i As Long
Dim WY As Worksheet
Set WY = Worksheets("Sheet4")
WY.Rows(1).Insert shift:=xlShiftDown
For i = 40 To 1 Step -1
Select Case WY.Cells(2, i)
Case "Physical Location", "PLC Tag Name", "Test Step1", "Test Step2", _
"Test Step3", "Test Step4", "Test Step5", "Test Step6", "Test Step7"
WY.Cells(1, i) = 1
Case Else
WY.Columns(i).EntireColumn.Delete
End Select
Next i
End Sub
Upvotes: 3