VBA Code to delete empty columns after a certain row

[NSegna]

Hello,
I was wondering if there was a VBA code that can delete all columns that are blank after a certain row.
For example, the code would delete the last 3 columns but keep the first 3 even though Rows 1 and 2 have a value in them.

[TABLE="width: 301"]
<colgroup><col width="61" style="width: 46pt; mso-width-source: userset; mso-width-alt: 2230;"><colgroup><col width="68" style="width: 51pt; mso-width-source: userset; mso-width-alt: 2486;" span="5"><tbody>[TR]
[TD="width: 61, bgcolor: transparent"]1[/TD]
[TD="width: 68, bgcolor: transparent"]2[/TD]
[TD="width: 68, bgcolor: transparent"]3[/TD]
[TD="width: 68, bgcolor: transparent"]4[/TD]
[TD="width: 68, bgcolor: transparent"]5[/TD]
[TD="width: 68, bgcolor: transparent"]6[/TD]
[/TR]
[TR]
[TD="bgcolor: transparent"]QUANTITY[/TD]
[TD="bgcolor: transparent"]QUANTITY2[/TD]
[TD="bgcolor: transparent"]QUANTITY3[/TD]
[TD="bgcolor: transparent"]QUANTITY4[/TD]
[TD="bgcolor: transparent"]QUANTITY5[/TD]
[TD="bgcolor: transparent"]QUANTITY6[/TD]
[/TR]
[TR]
[TD="bgcolor: #C6E0B4"]10[/TD]
[TD="bgcolor: #C6E0B4"]5[/TD]
[TD="bgcolor: #C6E0B4"] [/TD]
[TD="bgcolor: #C6E0B4"] [/TD]
[TD="bgcolor: #C6E0B4"] [/TD]
[TD="bgcolor: #C6E0B4"] [/TD]
[/TR]
[TR]
[TD="bgcolor: #FFF2CC"]40[/TD]
[TD="bgcolor: #FFF2CC"] [/TD]
[TD="bgcolor: #FFF2CC"]20[/TD]
[TD="bgcolor: #FFF2CC"] [/TD]
[TD="bgcolor: #FFF2CC"] [/TD]
[TD="bgcolor: #FFF2CC"] [/TD]
[/TR]
</tbody>[/TABLE]

Thanks

 

[alansidman]

In your example you are deleting after 3 rows which is the last row. In your actual file, will you identify the row or will it be the last row? Please clarify how the row is determined.

 

[NSegna]

yes, row 3 would be the last on the file

 

[alansidman]

See the comment at the top of the code.

Option Explicit


Sub delcol()
[COLOR=#ff0000]'This code assumes that all columns to the right of the last[/COLOR]
[COLOR=#ff0000]'column in the last row will be deleted[/COLOR]
Dim i As Long, lr As Long, lc As Long
Dim last As Long
last = Cells(1, Columns.Count).End(xlUp).Column
lr = Range("A" & Rows.Count).End(xlUp).Row
lc = Cells(lr, Columns.Count).End(xlToLeft).Column + 1
Range(Cells(1, lc), Cells(1, last)).EntireColumn.Delete


End Sub

 

[NSegna]

Works perfectly, Thank you very much