Results 1 to 3 of 3
  1. #1
    New Lounger
    Join Date
    Apr 2015
    Posts
    7
    Thanks
    3
    Thanked 0 Times in 0 Posts

    Excel 2010 - Deleting columns

    Hi,

    Rory and Zeddy were kind enough to help me with a problem recently, I now have a follow on request.

    On my spreadsheet I have data in columns A-AA which I want to keep.

    From AB onwards I would like to delete the first three columns and keep the following two and repeat this action.

    Example

    Delete AB, AC & AD... Keep AE & AF
    Delete AG, AH & AI... Keep AJ & AK

    This goes on all the way up to column RGI which is 7000+ columns.


    I've attached a sample spreadsheet.

    Thanks for your help.
    Attached Files Attached Files

  2. #2
    WS Lounge VIP rory's Avatar
    Join Date
    Dec 2000
    Location
    Burwash, East Sussex, United Kingdom
    Posts
    6,280
    Thanks
    3
    Thanked 191 Times in 177 Posts
    Try this on a copy of your real workbook:

    Code:
    Sub foo()
        Dim rDelete               As Range
        Dim lCol                  As Long
        Dim lCalc                 As Long
    
        For lCol = Cells(1, Columns.Count).End(xlToLeft).Column - 4 To Range("AB1").Column Step -5
            If rDelete Is Nothing Then
                Set rDelete = Cells(1, lCol).Resize(, 3)
            Else
                Set rDelete = Union(rDelete, Cells(1, lCol).Resize(, 3))
            End If
        Next lCol
    
        '    Debug.Print rDelete.Address
    
        With Application
            .ScreenUpdating = False
            lCalc = .Calculation
            .Calculation = xlCalculationManual
    
            rDelete.EntireColumn.Delete
    
            .Calculation = lCalc
            .ScreenUpdating = True
        End With
    End Sub
    Regards,
    Rory

    Microsoft MVP - Excel

  3. The Following User Says Thank You to rory For This Useful Post:

    udders (2015-05-14)

  4. #3
    New Lounger
    Join Date
    Apr 2015
    Posts
    7
    Thanks
    3
    Thanked 0 Times in 0 Posts
    Quote Originally Posted by rory View Post
    Try this on a copy of your real workbook:

    Code:
    Sub foo()
        Dim rDelete               As Range
        Dim lCol                  As Long
        Dim lCalc                 As Long
    
        For lCol = Cells(1, Columns.Count).End(xlToLeft).Column - 4 To Range("AB1").Column Step -5
            If rDelete Is Nothing Then
                Set rDelete = Cells(1, lCol).Resize(, 3)
            Else
                Set rDelete = Union(rDelete, Cells(1, lCol).Resize(, 3))
            End If
        Next lCol
    
        '    Debug.Print rDelete.Address
    
        With Application
            .ScreenUpdating = False
            lCalc = .Calculation
            .Calculation = xlCalculationManual
    
            rDelete.EntireColumn.Delete
    
            .Calculation = lCalc
            .ScreenUpdating = True
        End With
    End Sub
    Thanks again Rory, thats worked a treat.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •