CODEWITHSUNDEEP
excelvba
Stuck
Stuck

Reputation: 75

How can I omit columns based on a value and paste the results in a new sheet with VBA?

My VBA is quite rusty and I'm struggling to build this macro out

I'm looking to create a button macro to omit a few columns where header values are equal to - and paste the results into a new sheet.

My concern is I'm not sure how to make it so that the macro doesn't just omit the column and leave a blank column in the omitted columns place, though.

I've seen methods that set the columns as an array. However, this document has ~100 active columns, and I'm unsure how to curate an array efficiently with this many columns.

Thanks in advance!
Stuck

Upvotes: 0

Views: 33

Answers (1)

Josias Maestre
Josias Maestre

Reputation: 127

Hello there Stuck, I made this code based on your request and since I could probably need it in the near future, or someone else will.

I tested the code with 600 columns with 10 rows each and took about 1.30 seconds to finish, where 300 columns had header = "-" and the other 300 were columns with random header names.

There is no trick here, just using Range.SpecialCells(xlCellTypeVisible) -which only finds cells that are not hidden- should do the work, the rest is just normal steps.

Tell me if it worked for you since it could need some fixes to match your sheet model. Greatings!

   Sub test()
      Dim Rng_ As Range
      Dim Sheet_ As Worksheet
      
      
        'Disable animations while running
        Application.ScreenUpdating = False
        
        
      
        'Get CurrentRegion (Cells(1,1) is the same as Range("A1"))
        Set Rng_ = ActiveSheet.Cells(1, 1).CurrentRegion
        Rng_.Select
        
        
        'Get Headers row (Change it to the row where your headers are)
        Set Headers_ = Rng_.Rows(1)
        Headers_.Select
        
        
        'Hide headers = "-"
        For Each Header_ In Headers_.columns
            If Header_ Like "-" Then
                Set Column_ = Rng_.columns(Header_.Column)
                If Not (Column_.Hidden) Then Column_.Hidden = True
            End If
        Next
    
    
        'Get SpecialCells = xlCellTypeConstants
        On Error Resume Next
        Set Content_ = Nothing
        Set Content_ = Rng_.SpecialCells(xlCellTypeVisible)
        Content_.Select
        On Error GoTo 0
        
        
        'Create a new sheet
        If Not Content_ Is Nothing Then
            Set Workbook_ = Workbooks(Rng_.Parent.Parent.Name)
            Set Sheet_ = Workbook_.Sheets(Rng_.Parent.Name)
            Set Worksheet2_ = Workbook_.Worksheets.Add(after:=Sheet_)
            Worksheet2_.Name = Sheet_.Name & " | Filtered"
            Worksheet2_.Tab.Color = rgbCornflowerBlue                   'Add some color (life is colorful)
        
            'Paste the results into new sheet
            Content_.Copy Destination:=Worksheet2_.Cells.Range("A1")
        
        End If
    
    
    End Sub

Upvotes: 1

Related Questions