Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations IamaSherpa on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Delete Blank Columns 1

Status
Not open for further replies.

bobquest

Technical User
Apr 14, 2003
4
Need some VB help on deleting columns. I have a VB routine that will delete
entire rows, I just need some help getting it turned around to columns. This
works good and deletes entire blank rows only.

Thanks
Bob

Sub demo()
DeleteBlankDataRows "E", "AI"
End Sub

Sub DeleteBlankDataRows(FromColumn As String, ThruColumn As String)
Dim nFirstRow As Long
Dim nLastRow As Long
Dim nRow As Long
Dim sAddress As String
Dim rng As Range
With ActiveSheet.UsedRange
nLastRow = .Rows.Count + .Row - 1
nFirstRow = .Row
End With
Application.ScreenUpdating = False
For nRow = nLastRow To nFirstRow Step -1
sAddress = FromColumn & nRow & ":" & ThruColumn & nRow
Set rng = Range(sAddress)
If WorksheetFunction.CountBlank(rng) = rng.Count Then
rng.EntireRow.Delete
End If
Next nRow
Application.ScreenUpdating = True
End Sub



Bob
CARQUEST Auto Parts
Bob.Smith@gpi.com
 
Here's what I use:
Code:
Sub DeleteEmptyRowsAndColumns()
Application.ScreenUpdating = False
'following grabs the current activecell
BegAddress = ActiveCell.Address

Range("a1").EntireRow.Select
    With Selection
        Do
            If Application.WorksheetFunction.CountA(Selection) = 0 Then
            Selection.EntireRow.Delete
            Else
            Selection.Offset(1, 0).Select
            End If
        RowCount = ActiveSheet.UsedRange.Rows.Count
        Loop Until ActiveCell.Row >= RowCount
    End With

[blue]Range("a1").EntireColumn.Select
    With Selection
        Do
            If Application.WorksheetFunction.CountA(Selection) = 0 Then
            Selection.EntireColumn.Delete
            Else
            Selection.Offset(0, 1).Select
            End If
        ColumnCount = ActiveSheet.UsedRange.columns.Count
        Loop Until ActiveCell.Column >= ColumnCount
    End With[/blue]

Range(BegAddress).Activate
Application.ScreenUpdating = True
End Sub
This code does both rows and columns. The 'columns' part of the code is shown in blue.

[tt]_____
[blue]-John[/blue][/tt]
[tab][red]The plural of anecdote is not data[/red]

Help us help you. Please read FAQ181-2886 before posting.
 
Thanks for your help John,
Works great

Bob

Bob
CARQUEST Auto Parts
Bob.Smith@gpi.com
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top