CODEWITHSUNDEEP
excelvba
user1049961
user1049961

Reputation: 2736

Excel VBA - delete every 3rd and 4th column in range

Trying to figure out how to delete every 3rd and 4th column in range.

I know I can delete columns in range with:

Columns("C:E").EntireColumn.Delete

But cannot figure out how to delete only every 3rd and 4th...

Upvotes: 0

Views: 878

Answers (3)

EEM
EEM

Reputation: 6660

As previously mentioned by @YowE3K, it's not clear if the requirement is to:

  1. Delete every column that is multiple of 3 or 4 (i.e. columns 3,4,6,8,9,12,15,16,18,20,21,24,etc) or
  2. Delete 3rd and 4th column in every group of 4 columns (i.e. columns 3,4, 7,8, 11,12, 15,16, 19,20, 23,24, etc).

Therefore I’m providing a separated solution for each case:

These solutions delete at once all the columns within the worksheet UsedRange that comply with the requirements.

1.Delete every column that is multiple of 3 or 4

Sub Delete_Every_Column_Multiple_Of_3_or_4()
Dim rTrg As Range, iLstCol As Integer, i As Integer
    With ThisWorkbook.Sheets("Sht(1)")  'Change as required
        iLstCol = .UsedRange.SpecialCells(xlLastCell).Column
        For i = 1 To iLstCol
            If i <> 1 And (i Mod 3 = 0 Or i Mod 4 = 0) Then
                If rTrg Is Nothing Then
                    Set rTrg = .Columns(i)
                Else
                    Set rTrg = Union(rTrg, .Columns(i))
        End If: End If: Next
        rTrg.EntireColumn.Delete
    End With
End Sub

2.Delete 3rd and 4th column in every group of 4 columns 

Sub Delete_3rd_And_4th_Column_in_Every_Group_of_Four()
Dim rTrg As Range
Dim iLstCol As Integer
Dim i As Integer
    With ThisWorkbook.Sheets("Sht(2)")  'Change as required
        iLstCol = .UsedRange.SpecialCells(xlLastCell).Column
        For i = 1 To iLstCol
            If i Mod 4 = 0 Or i Mod 4 = 3 Then
                If rTrg Is Nothing Then
                    Set rTrg = .Columns(i)
                Else
                    Set rTrg = Union(rTrg, .Columns(i))
        End If: End If: Next
        rTrg.EntireColumn.Delete
    End With
End Sub

enter image description here Columns before for both cases.

enter image description here Columns after for both cases.

Upvotes: 1

z32a7ul
z32a7ul

Reputation: 3797

Public Sub DeleteEveryThirdColumn()
    Const EveryN As Long = 3
    Dim rng As Range: Set rng = ActiveSheet.Range("C:F")
    Dim c As Long: For c = ((rng.Columns.Count - 1) \ EveryN) * EveryN + 1 To 1 Step -EveryN
        rng.Columns(c).Delete
    Next c
End Sub

Upvotes: 0

Shai Rado
Shai Rado

Reputation: 33692

The code below deletes every 3rd and 4th column in "Sheet1" (modify the sheet's name according to your needs):

Option Explicit

Sub DeleteEvery_ThirdFourthCol()

Dim LastCol As Long
Dim Col As Long

' modify "Sheet1" to your sheet's name
With Sheets("Sheet1")    
    ' find last column with data in row 1 > modify to your needs
    LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column

    ' loop columns backwards when deleting
    For Col = LastCol To 1 Step -1
        If Col Mod 3 = 0 Or Col Mod 4 = 0 Then
            .Range(.Cells(1, Col), .Cells(1, Col)).EntireColumn.Delete
        End If
    Next Col            
End With

End Sub

Upvotes: 1

Related Questions