How to select and delete every 3rd column

Question

I have a set of data where every third column is the same. I want to leave only the first column and other which are the same must be deleted.

At first I tried this code but it deleted wrong columns because in every loop other columns positions were altered.

Sub DeleteMultipleColumns()
Dim i As Integer
Dim LastColumn As Long
Dim ws As Worksheet

Set ws = Sheets("Arkusz2")
LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
ws.Activate
For i = 4 To (LastColumn - 2)
   ws.Columns(i).Select
   Selection.Delete Shift:=xlToLeft
   i = i + 3
Next i
End Sub

After this I tried another one using Union. It doesn't work as well:

Sub DeleteMultipleColumns()
Dim i As Integer
Dim LastColumn As Long
Dim ws As Worksheet

Set ws = Sheets("Arkusz2")
LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column
ws.Activate
For i = 4 To (LastColumn - 2)
   Application.Union.Columns(i).Select
   i = i + 3
Next i
Selection.Delete Shift:=xlToLeft
End Sub

So how to do it?

My new idea is to try with an array. Do I have other options?

This is the code that I've implemented after your very good answers (thanks: sam092, meohow, mattboy):

Sub DeleteMultipleColumns()
Dim i As Integer
Dim LastColumn As Long
Dim ws As Worksheet
Application.ScreenUpdating = False
Set ws = Sheets("Arkusz2")
LastColumn = ws.Cells(1, Columns.Count).End(xlToLeft).Column - 2
For i = LastColumn To 4 Step -3
   ws.Columns(i).Delete Shift:=xlToLeft
Next i
Application.ScreenUpdating = True
End Sub

Deleting Range in a loop is the worst way to go about it. I would recommend seeing [THIS](http://stackoverflow.com/questions/19241905/vba-conditional-delete-loop-not-working/19241990#19241990) — Siddharth Rout, Oct 09 '13 at 08:17

score 5 · Accepted Answer · answered Oct 09 '13 at 07:21

5

Reverse the direction. Start deleting from the right. I think you know how to modify your code

answered Oct 09 '13 at 07:21

sam092

1,325
1
8
8

6

do you really think this is a good answer? it sound like a good comment to me ;) – Oct 09 '13 at 07:41
I've thought of providing the code. But I've decided to let OP himself try it out. Maybe you are right ;) – sam092 Oct 09 '13 at 07:45
1

the right code may be really simple to you or me to write but for the OP and any future visitor a explanation of the problem and a possible solution is more educative than just a hint of how to fix it :) the context of your answer is good but its lacking the code an maybe some explanation (IMO). :) – Oct 09 '13 at 07:47
1

@sam092, you really showed me root cause fot my code to not working properly :). Thanks, that was briliant idea! Other guys implement the idea- so thanks as well. However, you bring the idea. – Andrzej Jasienski Oct 09 '13 at 08:04

mattboy · Answer 2 · 2013-10-09T07:39:30.360

3

You can go backwards like this. Also, you don't need to select the column before deleting, you can simply delete it right away.

For i = ((LastColumn \ 4) * 4) To 4 Step -4
   ws.Columns(i).Delete Shift:=xlToLeft
Next i

edited Oct 09 '13 at 07:39

answered Oct 09 '13 at 07:29

mattboy

2,870
5
26
40

1

Instead of `(LastColumn - 2)`, he probably wants `(LastColumn \ 4) * 4`. Also, I suggest using `Step -4` instead of the `Step -1 ... i = i -3` combination – stephan Oct 09 '13 at 07:36

score 1 · Answer 3 · edited May 23 '17 at 12:28

I upvoted Mattboy's code as the cleanest

It is possible to avoid the range loop and use an array as you suggest, although I post this more for kicks as the array generation is tricky

Uses Is it possible to fill an array with row numbers which match a certain criteria without looping?

Sub OneinThree()
Dim ws As Worksheet
Dim rng1 As Range
Dim x As String
Set ws = ActiveSheet
Set rng1 = Cells(1, ws.Cells(1, Columns.Count).End(xlToLeft).Column - 2)
x = Join(Filter(Application.Evaluate("=IF(MOD(column(A1:" & rng1.Address & "),3)=0,address(1,column(a1:" & rng1.Address & ")),""x"")"), "x", False), ",")
If Len(x) > 0 Then ws.Range(x).EntireColumn.Delete
End Sub

How to select and delete every 3rd column

3 Answers3

Linked