Newbee - deleting blank columns

Rednosebob · 03-26-2006, 07:00 PM

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

JMB · 03-26-2006, 07:10 PM

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

Rednosebob · 03-27-2006, 06:45 AM

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

JMB · 03-27-2006, 11:55 PM

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

Rednosebob · 03-28-2006, 06:10 AM

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

JMB · 03-28-2006, 11:00 PM

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