Deleting entire columns based on column headers - excel

Question

I am trying to delete all the columns in an Excel sheet except the columns with the headers of "Product code" "Size" and "Quantity".
I have written the following code.
Sub delcolumns()
Dim Rng As Range
Dim cell As Range
Set Rng = Range(("A1"), Range("A1").End(xlToRight))
For Each cell In Rng
If cell.Value <> "Product Code" Or "Size" Or "Quantity" Then cell.EntireColumn.Delete
Next cell
End Sub
After running the micro the error says "Type mismatch"

Answer 1

You should work backwards when deleting rows or columns or you risk skipping over one or more.
Sub delcolumns()
Dim c as long, cols as variant
cols = array("Product Code", "Size", "Quantity")
for c = cells(1, columns.count).end(xltoleft).column to 1 step -1
if iserror(application.match(cells(1, c).value, cols, 0)) then
columns(c).entirecolumn.delete
end if
next c
End Sub
'alternative
Sub delcolumns()
Dim c as long
for c = cells(1, columns.count).end(xltoleft).column to 1 step -1
select case cells(1, c).value
case "Product Code", "Size", "Quantity"
'do nothing
case else
columns(c).entirecolumn.delete
end select
next c
End Sub
As far as your own code code, there are a couple of problems.
If cell.Value <> "Product Code" Or "Size" Or "Quantity" Then cell.EntireColumn.Delete
The above line is improper syntax. Each criteria needs to be written out longhand.
If cell.Value <> "Product Code" Or cell.Value <> "Size" Or cell.Value <> "Quantity" Then cell.EntireColumn.Delete
See Is variable required instead of “or” for alternatives.
More importantly, your logic is flawed. If one column is Product Code, then it isn't Size or Quantity and it will get deleted. You actually want,
If cell.Value <> "Product Code" AND cell.Value <> "Size" AND cell.Value <> "Quantity" Then cell.EntireColumn.Delete
Using And instead of Or means that the column is none of the three then delete.

Answer 2

You won't have to delete backwards using this code. This method tends to be more efficient since the actions are outside of the loop.
Say that you have 20 columns and intend to delete 17 of them (keep your 3 columns that are needed). This means you will have 17 iterations of columns being deleted and rows being shifted.
Instead, keep track of your target columns to delete using Union (collection of cells) and then delete everything all at once outside of the loop. No matter how many columns you have to be deleted, you will always do it all in once instance rather n instances. The larger the number of columns to be deleted, the greater the gains from using this method.
Option Explicit
Sub DeleteMe()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("Sheet1") '<-- Update sheet
Dim LC As Long, MyHeader As Range, DeleteMe As Range
LC = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
For Each MyHeader In ws.Range(ws.Cells(1, 1), ws.Cells(1, LC))
Select Case MyHeader
Case "Product code", "Size", "Quantity"
Case Else
If Not DeleteMe Is Nothing Then
Set DeleteMe = Union(DeleteMe, MyHeader)
Else
Set DeleteMe = MyHeader
End If
End Select
Next MyHeader
If Not DeleteMe Is Nothing Then DeleteMe.EntireColumn.Delete
End Sub

Answer 3

Write back a resized array without backward loops
In addition to the valid solutions above and in order to show an alternative approach using the advanced features of the
Application.Index function: all actions are executed within an array before writing it back to sheet.
Method
The Application.Index function allows not only to receive row and column numbers as arguments, but also row and column arrays with certain restructuring possibilities. The rows array contains the complete set of rows, the column array is built by a helper function getColNums() containing the related column numbers to the wanted titles "Product code", "Size" and "Quantity". - You might find some interesting pecularities of this function at Insert first column in datafield array without loops or API call.
Code example
This code example assumes a data range A1:F1000 which can be changed easily to your needs.
Sub RestructureColumns()
Dim rng As Range, titles(), v
titles = Array("Product code", "Size", "Quantity") ' << define wanted column titles
Set rng = ThisWorkbook.Worksheets("Sheet1").Range("A1:F1000") ' << change to wanted sheet and data range
' [1a] create 2-dim data field array (1-based)
v = rng.Value2
' [1b] filter out columns to be deleted, i.e. maintain the rest
v = Application.Index(v, Evaluate("row(1:" & rng.Rows.count & ")"), getColNums(v, titles))
' [2] write data field back to resized range
rng = "" ' clear lines
rng.Resize(UBound(v), UBound(v, 2)) = v ' write back only columns with predefined titles
End Sub
'Helper function getColNums()
Function getColNums(v, titles) As Variant()
' Purpose: return array of column numbers related to wanted titles, e.g. 1st, 3rd and 6th column
Dim tmpAr, title, foundCol, i& ' declare variables
ReDim tmpAr(0 To UBound(titles)) ' dimension array to titles length
For Each title In titles ' check the wanted titles only ...
foundCol = Application.Match(title, Application.Index(v, 1, 0), 0) ' ... against the complete title row
If Not IsError(foundCol) Then tmpAr(i) = foundCol: i = i + 1 ' if found add col no, increment counter
Next title
ReDim Preserve tmpAr(0 To i - 1) ' (redundant if all titles available)
getColNums = tmpAr ' return built array
End Function