delete empty column in VBA

[Lillian]

I have excel spreed sheet that I have some empty column
in between the columns, is anyway write the macro to do
that? also if all entire column has "0" and "NA", can I
deleted them all as well.

thanks.


Lillian

 

[Tom Ogilvy]

I assume if a column has only Errors, 0, blank cells or a combination, then
delete.

Sub AAA1()
Dim rng As Range
Dim rng1 As Range
Dim cell As Range
Dim cnt As Long, cnt1 As Long
Dim i As Long
With ActiveSheet
cnt = .UsedRange.Rows.Count
Set rng = .UsedRange.Columns(.UsedRange.Columns.Count).Cells(1, 1)
For i = rng.Column To 1 Step -1
Set rng1 = Intersect(.Columns(i), .UsedRange.EntireRow).Cells
If Application.CountA(rng1) = 0 Then
rng1.EntireColumn.Delete
Else
cnt1 = 0
For Each cell In rng1
If IsNumeric(cell.Value) Then
If cell.Value = 0 Then
cnt1 = cnt1 + 1
End If
ElseIf IsError(cell) Then
cnt1 = cnt1 + 1
ElseIf IsEmpty(cell) Then
cnt1 = cnt1 + 1
End If
Next
If cnt = cnt1 Then _
rng1.EntireColumn.Delete
End If
Next
End With
End Sub

 

[Guest]

Tom:

Let me give an example as following:

A B C D E F G H

0 NA 0 123
0 NA 0 222
0 NA 0 333
0 NA 0 444
0 NA 0 555

If you see entire ColumnA is "0", entire ColumnC is "NA"
entire ColumnD is "0", how to write the macro to delete
entire columnA,C,D, not just delete value, also column
need to delete as well, otherwise leave a lots of empty
column in between of columns.
also on this example Column E,F,G is empty column, how
to deleted the empty column then H column will be move to
left, I mean is all the entire spreed sheet data is from
ColumnA to 30 columns to the right need moved close
together, I don't want to scrool data to the right to see
entire row.

thank you for all the help.

Lillian

-----Original Message-----
I assume if a column has only Errors, 0, blank cells or a combination, then
delete.

Sub AAA1()
Dim rng As Range
Dim rng1 As Range
Dim cell As Range
Dim cnt As Long, cnt1 As Long
Dim i As Long
With ActiveSheet
cnt = .UsedRange.Rows.Count
Set rng = .UsedRange.Columns

(.UsedRange.Columns.Count).Cells(1, 1)

For i = rng.Column To 1 Step -1
Set rng1 = Intersect(.Columns

(i), .UsedRange.EntireRow).Cells

 

[Lillian]

Tom:

I did try this macro, it's cool, it delete if any
columns has value 0, or empty, it will be delete then move
to the left, that's great.

How about if I want to delete any column has
value "NA", can we included in this macro?

in this macro I have question?
what is rng and rng1, is rng is for column, rng1 is for
row, in your code, you said:

1). For i =rng.Column to 1 Step -1
what you use -1?

2).Can you explain line by line on your code, I am confuse
try to understand your macro.

I really appreciated it.

Lillian

-----Original Message-----
I assume if a column has only Errors, 0, blank cells or a combination, then
delete.

Sub AAA1()
Dim rng As Range
Dim rng1 As Range
Dim cell As Range
Dim cnt As Long, cnt1 As Long
Dim i As Long
With ActiveSheet
cnt = .UsedRange.Rows.Count
Set rng = .UsedRange.Columns

(.UsedRange.Columns.Count).Cells(1, 1)

For i = rng.Column To 1 Step -1
Set rng1 = Intersect(.Columns

(i), .UsedRange.EntireRow).Cells

 

[Dave Peterson]

See a couple more replies to your previous thread.

 

[Tom Ogilvy]

When you delete columns, you want to work form the right side of the
worksheet back to the left, or your code will miss columns (unless you
program specifically to avoid that, but it is easier to move from right to
left - thus I loop from the last column to the first column. The Step -1
tells it to decrement the loop counter

for i = 256 to 1 step -1 for example. However, I determine the last
used column and start from there to save some work.

Sub AAA1()
Dim rng As Range
Dim rng1 As Range
Dim cell As Range
Dim cnt As Long, cnt1 As Long
Dim i As Long
With ActiveSheet
cnt = .UsedRange.Rows.Count
' get the rightmost column, use the cell in row 1 of that column as
' a reference (rng)
Set rng = .UsedRange.Columns(.UsedRange.Columns.Count).Cells(1, 1)
For i = rng.Column To 1 Step -1 ' loop from last column to first
' set a reference to the rows of the ith column for the used range
Set rng1 = Intersect(.Columns(i), .UsedRange.EntireRow).Cells
' No determine if the column is all blank or only has 0, errors, "NA"
' if the column is a mixture of these, it will also be deleted.
If Application.CountA(rng1) = 0 Then
rng1.EntireColumn.Delete
Else
cnt1 = 0
For Each cell In rng1
If IsNumeric(cell.Value) Then
If cell.Value = 0 Then
cnt1 = cnt1 + 1
End If
ElseIf IsError(cell) Then
cnt1 = cnt1 + 1
ElseIf Trim(Ucase(cell.Value)) = "NA"
cnt1 = cnt1 + 1
ElseIf IsEmpty(cell) Then
cnt1 = cnt1 + 1
End If
Next
' if the criteria is met, the entirecolumn is deleted
If cnt = cnt1 Then _
rng1.EntireColumn.Delete
End If
Next
End With
End Sub

 

[Lillian]

Tom:

I try use your macro to complie, it said:
complier error, invalid outside on
ElseIf Trim(Ucase(cell.Value)) = "NA"
it show red color, what's wrong with this?


thanks for the help.

Lillian

-----Original Message-----
When you delete columns, you want to work form the right side of the
worksheet back to the left, or your code will miss columns (unless you
program specifically to avoid that, but it is easier to move from right to
left - thus I loop from the last column to the first column. The Step -1
tells it to decrement the loop counter

for i = 256 to 1 step -1 for example. However, I determine the last
used column and start from there to save some work.

Sub AAA1()
Dim rng As Range
Dim rng1 As Range
Dim cell As Range
Dim cnt As Long, cnt1 As Long
Dim i As Long
With ActiveSheet
cnt = .UsedRange.Rows.Count
' get the rightmost column, use the cell in row 1 of that column as
' a reference (rng)
Set rng = .UsedRange.Columns

(.UsedRange.Columns.Count).Cells(1, 1)

For i = rng.Column To 1 Step -1 ' loop from last column to first
' set a reference to the rows of the ith column for the used range
Set rng1 = Intersect(.Columns

(i), .UsedRange.EntireRow).Cells

 

[Tom Ogilvy]

ElseIf Trim(Ucase(cell.Value)) = "NA"

should be

ElseIf Trim(Ucase(cell.Value)) = "NA" then

 

[Lillian]

Tom:

The error is gone, but "NA" column still there, it did
not delete at all.


Lillian

 

[Tom Ogilvy]

It must not be filled with NA.

 

[Tom Ogilvy]

Yep, with the correction, it worked fine for me including deleting columns
containing NA in all rows.

Sub AAA1()
Dim rng As Range
Dim rng1 As Range
Dim cell As Range
Dim cnt As Long, cnt1 As Long
Dim i As Long
With ActiveSheet
cnt = .UsedRange.Rows.Count
' get the rightmost column, use the cell in row 1 of that column as
' a reference (rng)
Set rng = .UsedRange.Columns(.UsedRange.Columns.Count).Cells(1, 1)
For i = rng.Column To 1 Step -1 ' loop from last column to first
' set a reference to the rows of the ith column for the used range
Set rng1 = Intersect(.Columns(i), .UsedRange.EntireRow).Cells
' No determine if the column is all blank or only has 0, errors, "NA"
' if the column is a mixture of these, it will also be deleted.
If Application.CountA(rng1) = 0 Then
rng1.EntireColumn.Delete
Else
cnt1 = 0
For Each cell In rng1
If IsNumeric(cell.Value) Then
If cell.Value = 0 Then
cnt1 = cnt1 + 1
End If
ElseIf IsError(cell) Then
cnt1 = cnt1 + 1
ElseIf Trim(UCase(cell.Value)) = "NA" Then
cnt1 = cnt1 + 1
ElseIf IsEmpty(cell) Then
cnt1 = cnt1 + 1
End If
Next
' if the criteria is met, the entirecolumn is deleted
If cnt = cnt1 Then _
rng1.EntireColumn.Delete
End If
Next
End With
End Sub