VBA to delete entire column based on calculation/value of zero

[IthoughtIknewExcel]

Hello,

I'm looking for some macro help. The below small section of a worksheet has a few 100 columns that vary in amount each week. I have built a macro to insert the top row (row 1) and sum the columns that contain sizes. What I'm hoping to achieve is to delete every column where the total units per size = 0. The 0's are sporadic in row 1. Whatever direction the macro takes, it needs to loop/repeat the delete 0 column multiple times. I've tried a few things but nothing has worked thus far. Any help would be appreciated!

Thank you!

							0	34	63	82	38	27	0	0	34	63	87	38	33	0	7	34	63	82	48	27	0	0	13	0	0	19
Intro Date	Product Type	Category	Model	Color	Cost	Units	XS	S	M	L	XL	2XL	3XL	1-	2-	4-	5	5-	6	6-	7	7-	8-	9-	10	10-	11-	12-	13	13-	14-	19
02/01/2018	JACKET	RUNNING	Q12331	RED	35	12		3	13	27	8				3	13	27	8				3	13	27	8
12/15/2018	JACKET	FOOTBALL	F12344	BLUE	35	412			7	5	2					7	5	2					7	5	2
02/01/2018	SHORT	FOOTBALL	123345	BLACK	35	2		3	8	9	2				3	8	9	2				3	8	9	2
02/01/2018	JACKET	FOOTBALL	121244	RED	35	4			6		2					6		2					6		2
12/15/2018	SHORT	RUNNING	CT0305	BLACK	35	18		4				2			4				2			4				2
02/01/2018	JACKET	RUNNING	CT6880	WHITE	25	1234					5	1						5	1						5	1
12/15/2018	JACKET	BASKETBALL	GG3224	WHITE	25	523		5			3	1			5			3	1			5			3	1
02/01/2018	PANT	BASKETBALL	Q12331	BLUE	25	123		1			4	4			1			4	4			1			4	4
02/01/2018	SHORT	RUNNING	F12344	BLUE	24	24			6	10	5	5				6	10	5	5				6	10	5	5
02/01/2018	PANT	BASKETBALL	123345	GREEN	24	234		4		1		12			4		1		12			4		1		12
11/15/2017	PANT	RUNNING	121244	GREEN	45	12		3	9	10	4				3	9	10	4				3	9	10	4
11/15/2017	PANT	BASKETBALL	CT0305	RED	45	234		5	11	15		2			5	11	15		2			5	11	15		2
11/15/2017	SHORT	BASKETBALL	CT6880	BLACK	45	12		3	3	3	1				3	3	3	1				3	3	3	1
05/01/2019	SHORT	SOCCER	DY3119	BLACK	50	54		3		2	2				3		2	2				3		2	2

 

[Joe4]

Try this:

Sub MyDeleteCols()

    Dim fc As Long, lc As Long, c As Long
    
    Application.ScreenUpdating = False
    
'   Find first and last column in row 1 with a value
    fc = Cells(1, 1).End(xlToRight).Column
    lc = Cells(1, Columns.Count).End(xlToLeft).Column
    
'   Loop through all columns backwards
    For c = lc To fc Step -1
'       Delete column if value in cell is zero
        If Cells(1, c) = 0 Then Columns(c).Delete Shift:=xlToLeft
    Next c
    
    Application.ScreenUpdating = True
    
End Sub

 

[Fluff]

If you are happy changing the formula to something like
=IFERROR(1/(1/SUM(H3:H16)),FALSE)
copied across giving

+Fluff.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1								FALSE	34	63	82	38	27	FALSE	FALSE	34	63	82	38	27	FALSE	FALSE	34	63	82	38
2	Intro Date	Product Type	Category	Model	Color	Cost	Units	XS	S	M	L	XL	2XL	3XL	1-	2-	4-	5	5-	6	6-	7	7-	8-	9-	10
3	02/01/2018	JACKET	RUNNING	Q12331	RED	35	12		3	13	27	8				3	13	27	8				3	13	27	8
4	12/15/2018	JACKET	FOOTBALL	F12344	BLUE	35	412			7	5	2					7	5	2					7	5	2
5	02/01/2018	SHORT	FOOTBALL	123345	BLACK	35	2		3	8	9	2				3	8	9	2				3	8	9	2
6	02/01/2018	JACKET	FOOTBALL	121244	RED	35	4			6		2					6		2					6		2
7	12/15/2018	SHORT	RUNNING	CT0305	BLACK	35	18		4				2			4				2			4
8	02/01/2018	JACKET	RUNNING	CT6880	WHITE	25	1234					5	1						5	1						5
9	12/15/2018	JACKET	BASKETBALL	GG3224	WHITE	25	523		5			3	1			5			3	1			5			3
10	02/01/2018	PANT	BASKETBALL	Q12331	BLUE	25	123		1			4	4			1			4	4			1			4
11	02/01/2018	SHORT	RUNNING	F12344	BLUE	24	24			6	10	5	5				6	10	5	5				6	10	5
12	02/01/2018	PANT	BASKETBALL	123345	GREEN	24	234		4		1		12			4		1		12			4		1
13	11/15/2017	PANT	RUNNING	121244	GREEN	45	12		3	9	10	4				3	9	10	4				3	9	10	4
14	11/15/2017	PANT	BASKETBALL	CT0305	RED	45	234		5	11	15		2			5	11	15		2			5	11	15
15	11/15/2017	SHORT	BASKETBALL	CT6880	BLACK	45	12		3	3	3	1				3	3	3	1				3	3	3	1
16	05/01/2019	SHORT	SOCCER	DY3119	BLACK	50	54		3		2	2				3		2	2				3		2	2
List

Cell Formulas
Range	Formula
H1:Z1	H1	=IFERROR(1/(1/SUM(H3:H16)),FALSE)

You could use

Sub DelCols()
   Range("1:1").SpecialCells(xlFormulas, xlLogical).EntireColumn.Delete
End Sub

 

[IthoughtIknewExcel]

If you are happy changing the formula to something like
=IFERROR(1/(1/SUM(H3:H16)),FALSE)
copied across giving

+Fluff.xlsm
	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X	Y	Z
1								FALSE	34	63	82	38	27	FALSE	FALSE	34	63	82	38	27	FALSE	FALSE	34	63	82	38
2	Intro Date	Product Type	Category	Model	Color	Cost	Units	XS	S	M	L	XL	2XL	3XL	1-	2-	4-	5	5-	6	6-	7	7-	8-	9-	10
3	02/01/2018	JACKET	RUNNING	Q12331	RED	35	12		3	13	27	8				3	13	27	8				3	13	27	8
4	12/15/2018	JACKET	FOOTBALL	F12344	BLUE	35	412			7	5	2					7	5	2					7	5	2
5	02/01/2018	SHORT	FOOTBALL	123345	BLACK	35	2		3	8	9	2				3	8	9	2				3	8	9	2
6	02/01/2018	JACKET	FOOTBALL	121244	RED	35	4			6		2					6		2					6		2
7	12/15/2018	SHORT	RUNNING	CT0305	BLACK	35	18		4				2			4				2			4
8	02/01/2018	JACKET	RUNNING	CT6880	WHITE	25	1234					5	1						5	1						5
9	12/15/2018	JACKET	BASKETBALL	GG3224	WHITE	25	523		5			3	1			5			3	1			5			3
10	02/01/2018	PANT	BASKETBALL	Q12331	BLUE	25	123		1			4	4			1			4	4			1			4
11	02/01/2018	SHORT	RUNNING	F12344	BLUE	24	24			6	10	5	5				6	10	5	5				6	10	5
12	02/01/2018	PANT	BASKETBALL	123345	GREEN	24	234		4		1		12			4		1		12			4		1
13	11/15/2017	PANT	RUNNING	121244	GREEN	45	12		3	9	10	4				3	9	10	4				3	9	10	4
14	11/15/2017	PANT	BASKETBALL	CT0305	RED	45	234		5	11	15		2			5	11	15		2			5	11	15
15	11/15/2017	SHORT	BASKETBALL	CT6880	BLACK	45	12		3	3	3	1				3	3	3	1				3	3	3	1
16	05/01/2019	SHORT	SOCCER	DY3119	BLACK	50	54		3		2	2				3		2	2				3		2	2
List

Cell Formulas
Range	Formula
H1:Z1	H1	=IFERROR(1/(1/SUM(H3:H16)),FALSE)

You could use

Sub DelCols()
   Range("1:1").SpecialCells(xlFormulas, xlLogical).EntireColumn.Delete
End Sub

Thank you both for the help! Fluff, your approach worked perfectly!!

 

[Fluff]

Glad we could help & thanks for the feedback