Delete Columns if multiple specific cells are empty in column

[johnmpc]

HI have the following spreadsheet.

Customer Name

Joanna Kenny

Email:

Company

Dynamic Construction

Phone No:

Address

Mobile No:

Order GP%

37.84%​

Total Profit

£51.27​

Total Not Inc VAT

£135.50​

Total including VAT

£162.60​

Code

Supplier

Product Description

Colour

Cost (Min)

Decoration

Sell

GP%

QTY

Sizing Chart

One Size

S

M

L

XL

2XL

3XL

4XL

5XL

OTHER

Decoration 1

Position 1

Decoration 2

Position 2

Decoration 3

Postition 3

PEN881M

Pencarrie

Russell Zip Neck Micro Fleece

Black

£11.65​

£19.75​

41.01%​

1​

Unisex

1​

Dynamic Construction

Left Chest

Code

Supplier

Product Description

Colour

Cost (Min)

Decoration

Sell

GP%

QTY

Sizing Chart

One Size

S

M

L

XL

2XL

3XL

4XL

5XL

OTHER

Decoration 1

Position 1

Decoration 2

Position 2

Decoration 3

Postition 3

embroidery

MPC

Embroidery

None

£1.25​

£1.75​

28.57%​

1​

Unisex

1​

Dynamic Construction

Left Chest

Code

Supplier

Product Description

Colour

Cost (Min)

Decoration

Sell

GP%

QTY

Sizing Chart

Trousers

30​

32​

34​

36​

38​

40​

42​

44​

OTHER

Decoration 1

Position 1

Decoration 2

Position 2

Decoration 3

Postition 3

PENRX601

Pencarrie

PRO RTX Pro Workwear Trouser

black

£6.99​

£12.00​

41.75%​

2​

Trousers

2​

Dynamic Construction

Left Chest

Code

Supplier

Product Description

Colour

Cost (Min)

Decoration

Sell

GP%

QTY

Sizing Chart

Ladies

6​

8​

10​

12​

14​

16​

18​

20​

OTHER

Decoration 1

Position 1

Decoration 2

Position 2

Decoration 3

Postition 3

PEN539F

Pencarrie

Russell Lds 65/35 Pique Polo

French Navy

£6.20​

£1.40​

£12.00​

36.67%​

4​

Ladies

2​

2​

Code

Supplier

Product Description

Colour

Cost (Min)

Decoration

Sell

GP%

QTY

Sizing Chart

Shoe Size

6

7

8

9

10

11

12

13

OTHER

Decoration 1

Position 1

Decoration 2

Position 2

Decoration 3

Postition 3

PENRs348M

Pencarrie

Result W-G Lightweight Trainers

black/grey

£26.95​

£42.00​

35.83%​

1​

Shoes

1​

I was previously only using 1 sizing header from Column K and could delete the columns if it was empty from a certain point down.

Now i would like to delete the column if all the cells 16,19,22,25,28,31,34,37,40,43,46,49,52 in each column are empty.

Thanks in advance

 

[Trebor76]

Hi johnmpc,

Try this (though initially on a copy of your data as the results cannot be undone if they are not as expected):

Option Explicit
Sub Macro1()

    Dim wsSrc As Worksheet
    Dim lngLastCol As Long, lngMyCol As Long
    Dim varRow As Variant
    Dim blnDeleteCol As Boolean
    
    Set wsSrc = ThisWorkbook.Sheets("Sheet1") '<- Sheet name with data. Change to suit if necessary.
    
    If WorksheetFunction.CountA(wsSrc.Cells) = 0 Then
        MsgBox "There is no data on & """ & wsSrc.Name & """ to work with.", vbExclamation
        Exit Sub
    Else
        lngLastCol = wsSrc.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
    End If
    
    Application.ScreenUpdating = False
    
    For lngMyCol = lngLastCol To 1 Step -1
        blnDeleteCol = True
        For Each varRow In Array(16, 19, 22, 25, 28, 31, 34, 37, 40, 43, 46, 49, 52)
            If Len(wsSrc.Cells(CLng(varRow), lngMyCol)) > 0 Then
               blnDeleteCol = False
               Exit For
            End If
        Next varRow
        If blnDeleteCol = True Then
            wsSrc.Columns(lngMyCol).Delete
        End If
    Next lngMyCol
    
    Application.ScreenUpdating = True

End Sub

Regards,

Robert