• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

deleting columns in Multiple sheets

kittu akula

New Member
Hi,

I am trying to correct this code .
Code:
Option Explicit

Sub delColumnsNotInDictionary()
    Dim d As Long, ky As Variant, dict As Object
    Dim c As Long, lc As Long

    Set dict = CreateObject("Scripting.Dictionary")
    dict.comparemode = vbTextCompare

    dict.Item("Sheet1") = Array("s.no", "cust.name", "product", "date")
    dict.Item("Sheet2") = Array("prod.disc", "address", "pin")
    dict.Item("Sheet50") = Array("foo", "bar")

    With ThisWorkbook
        For Each ky In dict.keys
            With Worksheets(ky)
                lc = .Cells.Find(What:="*", After:=.Cells(1, 1), LookIn:=xlFormulas, LookAt:=xlPart, _
                                 SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, _
                                 MatchCase:=False, SearchFormat:=False).Column
                For c = lc To 1 Step -1
                    'filter array method of 'not found in array'
                    'WARNING! CASE SENSITIVE SEARCH  - foo <> FOO
                    If UBound(Filter(dict.Item(ky), .Cells(1, c).Value2)) = -1 Then
                        '.Cells(1, c).EntireColumn.Delete
                    Else
                        Debug.Print .Cells(1, c).Value2 & " at " & _
                          UBound(Filter(dict.Item(ky), .Cells(1, c).Value2))
                    End If
                    'worksheet MATCH method of 'not found in array'
                    'Case insensitive search - foo == FOO
                    If IsError(Application.Match(.Cells(1, c).Value2, dict.Item(ky), 0)) Then
                        .Cells(1, c).EntireColumn.Delete
                    Else
                        Debug.Print .Cells(1, c).Value2 & " at " & _
                          Application.Match(.Cells(1, c).Value2, dict.Item(ky), 0)
                    End If
                Next c
            End With
        Next ky
    End With

    dict.RemoveAll: Set dict = Nothing

End Sub

in this code
dict.Item("Sheet1")= Array("s.no","cust.name","product","date") always deleting "s.no" columns from the sheet1 , i tried with different headings result is same.
 
Would something simple like this work for you ?, Change "C" to your column
Sub Remove()

Dim ws As Worksheet

For Each ws In ActiveWorkbook.Worksheets
ws.Column("C").EntireColumn.Delete

Next ws

End Sub
 
i have different columns with different name in 7 sheets ...i have to work with particular columns only remaining all columns not required ..so i am concentrating on those columns mentioned in above code.. remaining all should be deleted.
 
Hi !

I do not understand why a Dictionary object and MATCH Excel function !
And maybe check if it is case sensitive.

But from forum rules, better is an attachment with workbooks before and
after (expected result) with a crystal clear explanation of the purpose …
 
you can take TEST1 file as an example which is attached previously in same page. in that i have 7 sheets, in live environment i have around 25 to 30 columns in each sheets that's why i don't want look what are other column names , just i am looking at what i want that is with column names .

in sheet1 ("RequestID", "Username","Assignee") should be present remaining all should be deleted
in sheet2 ("Product","Module","Severity") should be present remaining all should be deleted.
in sheet3 ("Assignee","Severity") should be present remaining all should be deleted
in this way i want only columns which are specified, remaining all should be deleted up to 7 sheets

i hope u understood now
 
ohh!! what i mean to say is in other sheets also it will be same like

sheet4 ("M", "Module", "Severity")
sheet5 ("RequestID", "Product", "Severity", "Assignee")
sheet6 ("RequestID", "Username", "Severity", "Assignee")
sheet7 ("RequestID", "Username", "Module", "Assignee")

hope its fine now.. :)
 
Use a Dictionary object (Windows only) or
MATCH Excel function (Windows / MAC), not both …

As here there are very few columns to check, according to your post #5 attachment in previous thread, a MATCH demonstration :​
Code:
Sub Demo1()
    Dim W, N&, C&
    Application.ScreenUpdating = False
    W = Array(0, [{"RequestID","Username","Assignee"}], [{"Product","Module","Severity"}], [{"Severity","Assignee"}], _
                 [{"M","Module","Severity"}], [{"RequestID","Product","Severity","Assignee"}], _
                 [{"RequestID","Username","Severity","Assignee"}], [{"RequestID","Username","Module","Assignee"}])
For N = 1 To UBound(W)
    With ThisWorkbook.Worksheets(N).UsedRange.Columns
        For C = .Item(.Count).Column To .Column Step -1
           If IsError(Application.MATCH(.Cells(C).Value, W(N), 0)) Then .Item(C).Delete
        Next
    End With
Next
    Application.ScreenUpdating = True
End Sub
Do you like it ? So thanks to click on bottom right Like !
 
Hi,

I am getting below error

Run-time error '40036':

Application-defined or object-defined error

i made changes according to my original data.
 
Some bad change ! Try first with attachment from previous thread …

A variation :​
Code:
Sub Demo2()
    Dim V, W, N&, C&
    Application.ScreenUpdating = False
    V = [{"RequestID","Username","M","Product","Module","Severity","Assignee"}]
    W = Array(0, [{1,2,7}], [{4,5,6}], [{6,7}], [{3,5,6}], [{1,4,6,7}], [{1,2,6,7}], [{1,2,5,7}])
For N = 1 To UBound(W)
        For C = 1 To UBound(W(N)):  W(N)(C) = V(W(N)(C)):  Next
    With ThisWorkbook.Worksheets(N).UsedRange.Columns
        For C = .Item(.Count).Column To .Column Step -1
           If IsError(Application.MATCH(.Cells(C).Value, W(N), 0)) Then .Item(C).Delete
        Next
    End With
Next
    Application.ScreenUpdating = True
End Sub

If headers to keep may change, better is to use a parameter worksheet …
 
Hi Mark,

its working perfectly for TEST1 file, but its only a dummy file.
the original file contains some thing like the below and its 10MB file so i don't want to upload it

i made changes as below

Code:
W = Array(0, [{"RequestID", "Customer Name", "Product","Severity","Assignee", "Status", "SubStatus", "Category", "Logged Date", "SubStatus", "Category","Logged Date", "Modified Date", "Location", "SLA (days)"}], [{"RequestID", "BankName", "Requestor", "Product", "Version", "Module", "Severity", "Assignee", "Lodged Date", "Last Modified", "Status", "Internal Status", "SLA(Hrs)", "TATInfy(Hrs)", "TATCust(Hrs)", "SLA Agreement", "Location Status", "Category"}], [{"RequestID", "Customer Name", "Product", "Location Status", "Module", "Product version", "Severity", "Assignee", "Status", "SubStatus", "Category", "Logged Date", "Modified Date", "Location", "SLA (days)"}], _
                 [{"RequestID", "Customer Name", "Location Status", "Product", "Severity", "Assignee", "Requestor", "Reopened Date", "Status", "Reopen Comment"}], [{"RequestID", "BankName", "Requestor", "Product", "Version", "Module", "Assignee", "Severity", "LodgedDate", "Status", "InternalStatus", "SLA(Hrs)", "TATInfy", "SLA HRS LEFT", "SLA Agreement", "Location Status","Category"}], _
                 [{"RequestID", "BankName", "Requestor", "Product", "Version", "Module", "Assignee", "Severity", "LodgedDate", "Status", "InternalStatus", "SLA(Hrs)", "TATInfy", "SLA HRS LEFT", "sLA Agreement", "Location Status", "Category"}], [{"RequestID", "BankName", "Requestor", "Product", "Version", "Module", "Assignee", "Severity", "LodgedDate", "Status", "InternalStatus", "SLA(Hrs)", "TATInfy", "SLA HRS LEFT", "sLA Agreement", "Location Status", "Category"}], [{"RequestID", "BankName", "Requestor", "Product", "Version","Module","Assignee", "Severity", "LodgedDate", "Status", "InternalStatus", "SLA(Hrs)", "TATInfy", "SLA HRS LEFT", "sLA Agreement", "Location Status", "Category"}])
let me know if i made any mistake
 

No as I wrote code works with the first 8 worksheets
(from W array from 1 to its last index)
so not by name but by worksheets order index …​
 
Hi Marc,

need your inputs.. can i add two more sheets in this ...and in future i may need to add some more sheets in it ...how do i change the code...as you mentioned in your previous post "No as I wrote code works with the first 8 worksheets " ..just want to know if can i add more sheets ..then how??

i tried to add some more sheets ..but getting run time error

Run-time error '40036':

Application-defined or object-defined error
 
As it depends on which codeline error occurs and as I'm not a mind reader …

As code works on W array variable, you just need to update this variable
adding new headers to keep and thus respecting worksheets order !
For example if you have the first 10 worksheets to mod,
upper index of W array variable in Locals window must be 10.

Another way as I yet wrote to not mod the code
is to add a parameter worksheet where columns to keep
are defined for each worksheet (by name) …
 
Back
Top