Excel 2000 - I have a spreadsheet that is laid out to have enough columns
formated for the maxium possible uaeage for this application. The number of
columns actually used will vary. I know the maximum columns used, but I need
a macro that will delete all blank columns.

Thanks in advance for your help!

Bob

Backup before testing. This will work on the activesheet, change if necessary.

Sub test()
Dim rCol As Range
Dim RngToDelete As Range

For Each rCol In ActiveSheet.UsedRange.Columns
If Application.CountA(rCol) = 0 Then
If RngToDelete Is Nothing Then
Set RngToDelete = rCol
Else: Set RngToDelete = Union(RngToDelete, rCol)
End If
End If
Next rCol

If Not RngToDelete Is Nothing Then _
RngToDelete.EntireColumn.Delete

End Sub

"Rednosebob" wrote:

Excel 2000 - I have a spreadsheet that is laid out to have enough columns
formated for the maxium possible uaeage for this application. The number of
columns actually used will vary. I know the maximum columns used, but I need
a macro that will delete all blank columns.

Thanks in advance for your help!

Bob

I want to pass a minimum and maximum column number to this subroutine
(MinCol, MaxCol). Is this possible? I'm not familar with ranges like I
should be. I appreciate your comments!

Bob

"JMB" wrote:

Backup before testing. This will work on the activesheet, change if necessary.

Sub test()
Dim rCol As Range
Dim RngToDelete As Range

For Each rCol In ActiveSheet.UsedRange.Columns
If Application.CountA(rCol) = 0 Then
If RngToDelete Is Nothing Then
Set RngToDelete = rCol
Else: Set RngToDelete = Union(RngToDelete, rCol)
End If
End If
Next rCol

If Not RngToDelete Is Nothing Then _
RngToDelete.EntireColumn.Delete

End Sub

"Rednosebob" wrote:

Excel 2000 - I have a spreadsheet that is laid out to have enough columns
formated for the maxium possible uaeage for this application. The number of
columns actually used will vary. I know the maximum columns used, but I need
a macro that will delete all blank columns.

Thanks in advance for your help!

Bob

Pass Min and Max columns as parameters or user inputs? Also, the way it is
written, it will run on the active sheet, which can be selected prior to
running the code (to make it the active sheet) or the range references in the
subroutine will have to be fully qualified to identify specifically what
sheet it should run on (more on that at the end of the post). Also, I tested
it with both column numbers (1,2,3) and letters (A, B, C).

If as user inputs:

Sub test()
Dim rCol As Range
Dim MinCol As Variant
Dim MaxCol As Variant
Dim RngToDelete As Range

On Error Resume Next

MinCol = InputBox("Input Minimum Column")
MaxCol = InputBox("Input Maximum Column")

If IsNumeric(MinCol) Then
Set MinCol = Columns(CLng(MinCol))
Else: Set MinCol = Columns(MinCol)
End If

If IsNumeric(MaxCol) Then
Set MaxCol = Columns(CLng(MaxCol))
Else: Set MaxCol = Columns(MaxCol)
End If

If Not MinCol Is Nothing And _
Not MaxCol Is Nothing Then
For Each rCol In Range(MinCol.Cells(1, 1), _
MaxCol.Cells(Rows.Count, 1)).Columns
If Application.CountA(rCol) = 0 Then
If RngToDelete Is Nothing Then
Set RngToDelete = rCol
Else: Set RngToDelete = Union(RngToDelete, rCol)
End If
End If
Next rCol
End If

If Not RngToDelete Is Nothing Then _
RngToDelete.EntireColumn.Delete

End Sub


If parameters (not tested)

Sub test(MinCol As Variant, MaxCol As Variant)
Dim rCol As Range
Dim RngToDelete As Range

On Error Resume Next

'Delete these two lines
'MinCol = InputBox("Input Minimum Column")
'MaxCol = InputBox("Input Maximum Column")

Rest of code goes here......



If you need to qualify the worksheet then do it here - I used the codename
for the sheet (Sheet2), but you can also use the tab name with
Worksheets("YourSheetName") - I like using codename as it is less likely to
be changed, causing code to fail.

If IsNumeric(MinCol) Then
Set MinCol = Sheet2.Columns(CLng(MinCol))
Else: Set MinCol = Sheet2.Columns(MinCol)
End If

If IsNumeric(MaxCol) Then
Set MaxCol = Sheet2.Columns(CLng(MaxCol))
Else: Set MaxCol = Sheet2.Columns(MaxCol)
End If


"Rednosebob" wrote:

I want to pass a minimum and maximum column number to this subroutine
(MinCol, MaxCol). Is this possible? I'm not familar with ranges like I
should be. I appreciate your comments!

Bob

"JMB" wrote:

Backup before testing. This will work on the activesheet, change if necessary.

Sub test()
Dim rCol As Range
Dim RngToDelete As Range

For Each rCol In ActiveSheet.UsedRange.Columns
If Application.CountA(rCol) = 0 Then
If RngToDelete Is Nothing Then
Set RngToDelete = rCol
Else: Set RngToDelete = Union(RngToDelete, rCol)
End If
End If
Next rCol

If Not RngToDelete Is Nothing Then _
RngToDelete.EntireColumn.Delete

End Sub

"Rednosebob" wrote:

Excel 2000 - I have a spreadsheet that is laid out to have enough columns
formated for the maxium possible uaeage for this application. The number of
columns actually used will vary. I know the maximum columns used, but I need
a macro that will delete all blank columns.

Thanks in advance for your help!

Bob

I've used the later version where I can pass the parameters. It works
exactly like I wanted it to. Thanks for your help!

Bob

"JMB" wrote:

Pass Min and Max columns as parameters or user inputs? Also, the way it is
written, it will run on the active sheet, which can be selected prior to
running the code (to make it the active sheet) or the range references in the
subroutine will have to be fully qualified to identify specifically what
sheet it should run on (more on that at the end of the post). Also, I tested
it with both column numbers (1,2,3) and letters (A, B, C).

If as user inputs:

Sub test()
Dim rCol As Range
Dim MinCol As Variant
Dim MaxCol As Variant
Dim RngToDelete As Range

On Error Resume Next

MinCol = InputBox("Input Minimum Column")
MaxCol = InputBox("Input Maximum Column")

If IsNumeric(MinCol) Then
Set MinCol = Columns(CLng(MinCol))
Else: Set MinCol = Columns(MinCol)
End If

If IsNumeric(MaxCol) Then
Set MaxCol = Columns(CLng(MaxCol))
Else: Set MaxCol = Columns(MaxCol)
End If

If Not MinCol Is Nothing And _
Not MaxCol Is Nothing Then
For Each rCol In Range(MinCol.Cells(1, 1), _
MaxCol.Cells(Rows.Count, 1)).Columns
If Application.CountA(rCol) = 0 Then
If RngToDelete Is Nothing Then
Set RngToDelete = rCol
Else: Set RngToDelete = Union(RngToDelete, rCol)
End If
End If
Next rCol
End If

If Not RngToDelete Is Nothing Then _
RngToDelete.EntireColumn.Delete

End Sub


If parameters (not tested)

Sub test(MinCol As Variant, MaxCol As Variant)
Dim rCol As Range
Dim RngToDelete As Range

On Error Resume Next

'Delete these two lines
'MinCol = InputBox("Input Minimum Column")
'MaxCol = InputBox("Input Maximum Column")

Rest of code goes here......



If you need to qualify the worksheet then do it here - I used the codename
for the sheet (Sheet2), but you can also use the tab name with
Worksheets("YourSheetName") - I like using codename as it is less likely to
be changed, causing code to fail.

If IsNumeric(MinCol) Then
Set MinCol = Sheet2.Columns(CLng(MinCol))
Else: Set MinCol = Sheet2.Columns(MinCol)
End If

If IsNumeric(MaxCol) Then
Set MaxCol = Sheet2.Columns(CLng(MaxCol))
Else: Set MaxCol = Sheet2.Columns(MaxCol)
End If


"Rednosebob" wrote:

I want to pass a minimum and maximum column number to this subroutine
(MinCol, MaxCol). Is this possible? I'm not familar with ranges like I
should be. I appreciate your comments!

Bob

"JMB" wrote:

Backup before testing. This will work on the activesheet, change if necessary.

Sub test()
Dim rCol As Range
Dim RngToDelete As Range

For Each rCol In ActiveSheet.UsedRange.Columns
If Application.CountA(rCol) = 0 Then
If RngToDelete Is Nothing Then
Set RngToDelete = rCol
Else: Set RngToDelete = Union(RngToDelete, rCol)
End If
End If
Next rCol

If Not RngToDelete Is Nothing Then _
RngToDelete.EntireColumn.Delete

End Sub

"Rednosebob" wrote:

Excel 2000 - I have a spreadsheet that is laid out to have enough columns
formated for the maxium possible uaeage for this application. The number of
columns actually used will vary. I know the maximum columns used, but I need
a macro that will delete all blank columns.

Thanks in advance for your help!

Bob

I'm glad that worked for you. Thanks for the feedback.


"Rednosebob" wrote:

I've used the later version where I can pass the parameters. It works
exactly like I wanted it to. Thanks for your help!

Bob

"JMB" wrote:

Pass Min and Max columns as parameters or user inputs? Also, the way it is
written, it will run on the active sheet, which can be selected prior to
running the code (to make it the active sheet) or the range references in the
subroutine will have to be fully qualified to identify specifically what
sheet it should run on (more on that at the end of the post). Also, I tested
it with both column numbers (1,2,3) and letters (A, B, C).

If as user inputs:

Sub test()
Dim rCol As Range
Dim MinCol As Variant
Dim MaxCol As Variant
Dim RngToDelete As Range

On Error Resume Next

MinCol = InputBox("Input Minimum Column")
MaxCol = InputBox("Input Maximum Column")

If IsNumeric(MinCol) Then
Set MinCol = Columns(CLng(MinCol))
Else: Set MinCol = Columns(MinCol)
End If

If IsNumeric(MaxCol) Then
Set MaxCol = Columns(CLng(MaxCol))
Else: Set MaxCol = Columns(MaxCol)
End If

If Not MinCol Is Nothing And _
Not MaxCol Is Nothing Then
For Each rCol In Range(MinCol.Cells(1, 1), _
MaxCol.Cells(Rows.Count, 1)).Columns
If Application.CountA(rCol) = 0 Then
If RngToDelete Is Nothing Then
Set RngToDelete = rCol
Else: Set RngToDelete = Union(RngToDelete, rCol)
End If
End If
Next rCol
End If

If Not RngToDelete Is Nothing Then _
RngToDelete.EntireColumn.Delete

End Sub


If parameters (not tested)

Sub test(MinCol As Variant, MaxCol As Variant)
Dim rCol As Range
Dim RngToDelete As Range

On Error Resume Next

'Delete these two lines
'MinCol = InputBox("Input Minimum Column")
'MaxCol = InputBox("Input Maximum Column")

Rest of code goes here......



If you need to qualify the worksheet then do it here - I used the codename
for the sheet (Sheet2), but you can also use the tab name with
Worksheets("YourSheetName") - I like using codename as it is less likely to
be changed, causing code to fail.

If IsNumeric(MinCol) Then
Set MinCol = Sheet2.Columns(CLng(MinCol))
Else: Set MinCol = Sheet2.Columns(MinCol)
End If

If IsNumeric(MaxCol) Then
Set MaxCol = Sheet2.Columns(CLng(MaxCol))
Else: Set MaxCol = Sheet2.Columns(MaxCol)
End If


"Rednosebob" wrote:

I want to pass a minimum and maximum column number to this subroutine
(MinCol, MaxCol). Is this possible? I'm not familar with ranges like I
should be. I appreciate your comments!

Bob

"JMB" wrote:

Backup before testing. This will work on the activesheet, change if necessary.

Sub test()
Dim rCol As Range
Dim RngToDelete As Range

For Each rCol In ActiveSheet.UsedRange.Columns
If Application.CountA(rCol) = 0 Then
If RngToDelete Is Nothing Then
Set RngToDelete = rCol
Else: Set RngToDelete = Union(RngToDelete, rCol)
End If
End If
Next rCol

If Not RngToDelete Is Nothing Then _
RngToDelete.EntireColumn.Delete

End Sub

"Rednosebob" wrote:

Excel 2000 - I have a spreadsheet that is laid out to have enough columns
formated for the maxium possible uaeage for this application. The number of
columns actually used will vary. I know the maximum columns used, but I need
a macro that will delete all blank columns.

Thanks in advance for your help!

Bob