Deleting Columns

[Cordury]

One of the finance apps that I use creates an empty column every other column when dumped into Excel. Depending on the report, the amount of columns vary.

I would like to create a macro that goes to the last empty column and works back towards column A, deleting all empty columns.

Any ideas?

Thanks

 

[Zathras]

This does what you describe:
[blue]

Option Explicit

Sub DeleteEmptyColumns()
Dim Row1 As Range
Dim nCol As Integer
  Set Row1 = Intersect(ActiveSheet.UsedRange, Range("1:1"))
  For nCol = Row1.Cells.Count To 1 Step -1
    If ColumnIsEmpty(nCol) Then
      Cells(1, nCol).EntireColumn.Delete
    End If
  Next nCol
  Set Row1 = Nothing
End Sub

Private Function ColumnIsEmpty(ColNum As Integer) As Boolean
Dim r As Range
  Set r = Cells(1, ColNum)
  If IsEmpty(r) Then
    Set r = r.End(xlDown)
    If IsEmpty(r) Then ColumnIsEmpty = True
  End If
  Set r = Nothing
End Function

[/color]

 

[Cordury]

Zathras,

Thanks for the quick response!
Take care.

 

[BrainB]

Can't think why you need to go to the end first, but anyway ..............
'----------------------------------------------------------
Sub test()
c = 1
Do Until ActiveSheet.Cells(1, c).Value = "" _
And ActiveSheet.Cells(1, c + 1).Value = ""
c = c + 1
Loop
Do Until c = 1
c = c - 1
If ActiveSheet.Cells(1, c).Value = "" Then
Columns(c).EntireColumn.Delete
End If
Loop
End Sub
'-----------------------------------------------------------------


Regards
BrianB
** Let us know if you get something that works !
================================

 

[Loomah]

Hi
A slightly different approach

Sub DelCols()
Dim i As Integer
For i = Worksheets("sheet1").UsedRange.Columns.Count To 1 Step -1
If WorksheetFunction.CountA(Columns(i)) = 0 Then Columns(i).Delete
Next
End Sub

;-)

If a man says something and there are no women there to hear him, is he still wrong?

 

[Cordury]

Brian B,

You have a good point. I guess I was thinking along the same line as another macro I have that deletes duplicate rows. It goes to the end of the sheet after it is sorted.

Sorry, I guess I have a case of the Mondays

 

[senators40]

Sub Macro1()
'This will move the cell to the last possible column in excel
Range("IV1&quot.Select
'This will move the cell to the first cell that has a value (if there is nothing in Row 1 in your last column then manually enter something there so the macro knows where to start deleting the columns)
Selection.End(xlToLeft).Select
Do Until ActiveCell = Range("A1&quot
ActiveCell.Offset(0, -1).Select
Selection.EntireColumn.Delete
ActiveCell.Offset(0, -1).Select
Loop
End Sub

Hope it helps

Jeff

 

[Loomah]

Hi
In this case starting at the first column would work fine because there would (in theory) only ever be one empty column at a time. However, if there is a possibility of more than one consecutive blank column (or row!) the second one will always get missed.

By way of example if columns A & B are empty starting at the beginning would delete column A OK. Then column B becomes column A. As the method of looping thru the columns has moved on and already checked column A it looks to col B. This is now full of data as the blank col (or row) has move accross (or up) by 1.

Starting at the 'end' avoids this problem so rather than wondering where's best to start, always start at the end and move backwards!

;-)

If a man says something and there are no women there to hear him, is he still wrong?

 

[Zathras]

BrianB - What if there 2 or more blank columns together? I know Cordury first said "every other column" but then he said "deleting all empty columns."

Loomah - What if both columns "A" and "B" are empty. Working with UsedRange can be tricky.

senators40 - Did you test your code? When I tried it, it trashed my data.

 

[Loomah]

Zathras
You are indeed correct!
And I've shot myself in the foot using it here out of laziness rather than actually identifying the last used column.
;-)

If a man says something and there are no women there to hear him, is he still wrong?

 

[Cordury]

Thanks all.
Brian- your code seems to work great.
senators40- I too had an issue with your code, but with the way my day is going- it is quite possibly user error.

 

[senators40]

I did try it and it does work the first time. The only thing that I missed was adding another line at the end of the loop. (to delete the blank column B blank)

ActiveCell.Offset(0, -1).Select
Selection.EntireColumn.Delete


The only thing I can think of is that you have to insert text in row 1 of the last column that you have data in (ie if you had numbers in row F2 but nothing in row F1 the macro will ignore the F column and go on to the D1 column.)

I am using Excel 97.

Let me know.

 

[KenWright]

And just for the OPs benefit, as Loomah and Zathras have pointed out, the ONLY safe way of deleting columns AND rows as well is to start at the end or the bottom and work back or up respectively.

For rows, last row can be found either by using

<snip>
lrow = ActiveSheet.UsedRange.Row - 1 + _
ActiveSheet.UsedRange.Rows.Count

For r = lrow To 1 Step -1
....
<snip>

or

<snip>
lrow = Cells(Rows.Count, &quot;A&quot.End(xlUp).Row
Set Rng = Range(Cells(1, &quot;A&quot, Cells(lrow, &quot;A&quot)

For x = Rng.Rows.Count To 1 Step -1
For Each cel In Rng.Rows(x)
.....
<snip>

Regards
Ken.............