Home | Contact Us | FAQ | Search & Site Map | Link to Us
Sign In | Join | Other 45 Sites in Network
Home
DiscussionsAccessExcelInfoPathOutlookPowerPointPublisherWord
DirectoryUser Groups
Related Topics
Outlook ExpressInternet ExplorerWindowsMS Server ProductsMore Topics ...
MS Office Forum / Excel / New Users / November 2007

Tip: Looking for answers? Try searching our database.

Hide column is empty, not including header (row 1)

Thread view: 
Enable EMail Alerts  Start New Thread
Thread rating: 
S Himmelrich - 09 Nov 2007 21:08 GMT
I'm lost on this one, but I'm sure there is simple macro code to do
this.  I need this in a macro as I'm massaging data that beyond
removing empty columns.
Reply to this Message
Dave Peterson - 09 Nov 2007 21:39 GMT
Option Explicit
Sub testme()

   Dim myCol As Range
   Dim wks As Worksheet
   
   Set wks = Worksheets("Sheet1")
   
   With wks
       For Each myCol In .UsedRange.Columns
           If Application.CountA(.Range(.Cells(2, myCol.Column), _
                             .Cells(.Rows.Count, myCol.Column))) = 0 Then
               'hide it
               myCol.Hidden = True
           Else
               'unhide any previously hidden column???
               myCol.Hidden = False
           End If
       Next myCol
   End With
   
End Sub

It's the same as looking at:  =Counta(a2:a65536) in xl2003.

> I'm lost on this one, but I'm sure there is simple macro code to do
> this.  I need this in a macro as I'm massaging data that beyond
> removing empty columns.

Signature

Dave Peterson

Reply to this Message
S Himmelrich - 09 Nov 2007 22:12 GMT
Thanks for your response.....

I'm not sure what I'm doing wrong but this is not working.  I'm not
including Option Explicit  or the Sub lines as the code you have
suggested is in the middle of other code, does the Option Explicit
have an impact that would not allow this to work?

Here is the code, which all works, except the area that you are
helping me with.....

Sub ryan_rae_weekly()

'Open file and execute macro against it
   Application.Dialogs(xlDialogFindFile).Show

'Unhide Sheets hidden sheets
   Dim Sheet As Worksheet
   For Each Sheet In Worksheets
   If Sheet.Visible = False Then
   Sheet.Visible = True
   End If
   Next Sheet

'Deletes the sheets that we don't use.
   Application.DisplayAlerts = False
   Sheets("UST Service Provider").Delete
   Sheets("US Trust Portfolio Info").Delete
   Sheets("US Trust BAU Portfolio Info").Delete
   Sheets("US Trust Project Info").Delete
   Sheets("Service Provider").Delete
   Sheets("Card Trans Portfolio Info").Delete
   Sheets("Card Trans Project Info").Delete
   Sheets("BAU Portfolio Info").Delete
   Sheets("BAU Project Info").Delete
   Sheets("Missing Timesheets").Delete
   Sheets("US Trust BAU Funded").Delete
   Application.DisplayAlerts = True

'Reorder Sheets
   Sheets("BAU Data").Select
   Sheets("BAU Data").Move Before:=Sheets(1)
   Sheets("Trans Data").Select
   Sheets("Trans Data").Move Before:=Sheets(2)

'Select BAU Data Sheet
   Sheets("BAU Data").Select

'Set View at 100%
   ActiveWindow.Zoom = 100

'Finds all rows with 'FS' and delete all other rows
   Dim Firstrow As Long
   Dim Lastrow As Long
   Dim Lrow As Long
   Dim CalcMode As Long
   Dim ViewMode As Long

   With Application
       CalcMode = .Calculation
       .Calculation = xlCalculationManual
       .ScreenUpdating = False
   End With

   'We use the ActiveSheet but you can replace this with
   'Sheets("MySheet")if you want
   With ActiveSheet

       'We select the sheet so we can change the window view
       .Select

       'If you are in Page Break Preview Or Page Layout view go
       'back to normal view, we do this for speed
       ViewMode = ActiveWindow.View
       ActiveWindow.View = xlNormalView

       'Turn off Page Breaks, we do this for speed
       .DisplayPageBreaks = False

       'Set the first and last row to loop through
       Firstrow = .UsedRange.Cells(1).Row + 1
       Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

       'We loop from Lastrow to Firstrow (bottom to top)
       For Lrow = Lastrow To Firstrow Step -1

       'We check the values in the G column in this example
       With .Cells(Lrow, "G")

       If Not IsError(.Value) Then

           If .Value <> "FS" Then .EntireRow.Delete
           'This will delete each row that doesn't have a Value "FS"
in Column G, case sensitive.

           End If

       End With

       Next Lrow

   End With

   ActiveWindow.View = ViewMode
   With Application
       .ScreenUpdating = True
       .Calculation = CalcMode
   End With

'Clean-up Worksheet
   Dim myLastRow As Long
   Dim myLastCol As Long
   Dim wks As Worksheet
   Dim dummyRng As Range

   For Each wks In ActiveWorkbook.Worksheets
     With wks
      myLastRow = 0
      myLastCol = 0
       Set dummyRng = .UsedRange
       On Error Resume Next
       myLastRow = _
       .Cells.Find("*", after:=.Cells(1), _
           LookIn:=xlFormulas, lookat:=xlWhole, _
           searchdirection:=xlPrevious, _
           searchorder:=xlByRows).Row
       myLastCol = _
       .Cells.Find("*", after:=.Cells(1), _
           LookIn:=xlFormulas, lookat:=xlWhole, _
           searchdirection:=xlPrevious, _
           searchorder:=xlByColumns).Column
       On Error GoTo 0

       If myLastRow * myLastCol = 0 Then
           .Columns.Delete
       Else
           .Range(.Cells(myLastRow + 1, 1), _
           .Cells(.Rows.Count, 1)).EntireRow.Delete
           .Range(.Cells(1, myLastCol + 1), _
           .Cells(1, .Columns.Count)).EntireColumn.Delete
       End If
   End With
   Next wks

' Sort by ECMSID Number
   Range("A1:S9639").Sort Key1:=Range("B2"), Order1:=xlAscending,
Header:= _
       xlGuess, OrderCustom:=1, MatchCase:=False,
Orientation:=xlTopToBottom, _
       DataOption1:=xlSortTextAsNumbers

' Hide Columns
   Range("A2").Select
   Columns("E:G").Select
   Selection.EntireColumn.Hidden = True
   Columns("H:L").Select
   Selection.EntireColumn.Hidden = True
   Columns("P:U").Select
   Selection.EntireColumn.Hidden = True
   Columns("N:N").Select
   Selection.EntireColumn.Hidden = True

' Format column O with 2 decimal
   Columns("O:O").Select
   Selection.NumberFormat = "0.00"

' Resize columns
' Column Widths
   Columns("A:B").Select
   Selection.ColumnWidth = 10.5
   Columns("C").Select
   Selection.ColumnWidth = 18.5
   Columns("D").Select
   Selection.ColumnWidth = 40.88
   Columns("M").Select
   Selection.ColumnWidth = 8.75
   Columns("O").Select
   Selection.ColumnWidth = 8.75

'Reposition
   Range("A2").Select

'Next Worksheet
'Select BAU Data Sheet
   Sheets("Trans Data").Select
   Range("A2").Select

'Set View at 100%
   ActiveWindow.Zoom = 100

'Finds all rows with 'FS' and delete all other rows
   With Application
       CalcMode = .Calculation
       .Calculation = xlCalculationManual
       .ScreenUpdating = False
   End With

   'We use the ActiveSheet but you can replace this with
   'Sheets("MySheet")if you want
   With ActiveSheet

       'We select the sheet so we can change the window view
       .Select

       'If you are in Page Break Preview Or Page Layout view go
       'back to normal view, we do this for speed
       ViewMode = ActiveWindow.View
       ActiveWindow.View = xlNormalView

       'Turn off Page Breaks, we do this for speed
       .DisplayPageBreaks = False

       'Set the first and last row to loop through
       Firstrow = .UsedRange.Cells(1).Row + 1
       Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

       'We loop from Lastrow to Firstrow (bottom to top)
       For Lrow = Lastrow To Firstrow Step -1

       'We check the values in the G column in this example
       With .Cells(Lrow, "G")

       If Not IsError(.Value) Then

           If .Value <> "FS" Then .EntireRow.Delete
           'This will delete each row that doesn't have a Value "FS"
in Column G, case sensitive.

           End If

       End With

       Next Lrow

   End With

   ActiveWindow.View = ViewMode
   With Application
       .ScreenUpdating = True
       .Calculation = CalcMode
   End With

'Clean-up Worksheet

   For Each wks In ActiveWorkbook.Worksheets
     With wks
      myLastRow = 0
      myLastCol = 0
       Set dummyRng = .UsedRange
       On Error Resume Next
       myLastRow = _
       .Cells.Find("*", after:=.Cells(1), _
           LookIn:=xlFormulas, lookat:=xlWhole, _
           searchdirection:=xlPrevious, _
           searchorder:=xlByRows).Row
       myLastCol = _
       .Cells.Find("*", after:=.Cells(1), _
           LookIn:=xlFormulas, lookat:=xlWhole, _
           searchdirection:=xlPrevious, _
           searchorder:=xlByColumns).Column
       On Error GoTo 0

       If myLastRow * myLastCol = 0 Then
           .Columns.Delete
       Else
           .Range(.Cells(myLastRow + 1, 1), _
           .Cells(.Rows.Count, 1)).EntireRow.Delete
           .Range(.Cells(1, myLastCol + 1), _
           .Cells(1, .Columns.Count)).EntireColumn.Delete
       End If
   End With
   Next wks

' Hide Columns
   Range("A2").Select
   Columns("E:G").Select
   Selection.EntireColumn.Hidden = True
   Columns("N:N").Select
   Selection.EntireColumn.Hidden = True
   Columns("P:S").Select
   Selection.EntireColumn.Hidden = True

' CODE FOR REMOVING BLANK COLUMNS
HERE!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
'!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
   Dim myCol As Range

   Set wks = Worksheets("Trans Data")

   With wks
       For Each myCol In .UsedRange.Columns
           If Application.CountA(.Range(.Cells(2, myCol.Column), _
                             .Cells(.Rows.Count, myCol.Column))) = ""
Then
               'hide it
               myCol.Hidden = True
           Else
               'unhide any previously hidden column???
               myCol.Hidden = False
           End If
       Next myCol
   End With

' Resize columns widths
   Columns("A:B").Select
   Selection.ColumnWidth = 10.5
   Columns("C").Select
   Selection.ColumnWidth = 18.5
   Columns("D").Select
   Selection.ColumnWidth = 40.88
   Selection.ColumnWidth = 34.57
   Columns("H:M").Select
   Selection.ColumnWidth = 8.75
   Columns("H:M").Select
   Selection.ColumnWidth = 8.75

' Format column O with 2 decimal
   Columns("H:O").Select
   Selection.NumberFormat = "0.00"

'Sort and subtotal by CR Number
   Range("A2").Select
   Selection.Subtotal GroupBy:=2, Function:=xlSum,
TotalList:=Array(8, 9, 10, _
       11, 12, 13, 15), Replace:=True, PageBreaks:=False,
SummaryBelowData:=True
'Reposition
   Range("A2").Select

'Next Worksheet
'Select BAU Data Sheet
   Sheets("US Trust Data").Select
   Range("A2").Select

'Set View at 100%
   ActiveWindow.Zoom = 100

'Finds all rows with 'FS' and delete all other rows
   With Application
       CalcMode = .Calculation
       .Calculation = xlCalculationManual
       .ScreenUpdating = False
   End With

   'We use the ActiveSheet but you can replace this with
   'Sheets("MySheet")if you want
   With ActiveSheet

       'We select the sheet so we can change the window view
       .Select

       'If you are in Page Break Preview Or Page Layout view go
       'back to normal view, we do this for speed
       ViewMode = ActiveWindow.View
       ActiveWindow.View = xlNormalView

       'Turn off Page Breaks, we do this for speed
       .DisplayPageBreaks = False

       'Set the first and last row to loop through
       Firstrow = .UsedRange.Cells(1).Row + 1
       Lastrow = .UsedRange.Rows(.UsedRange.Rows.Count).Row

       'We loop from Lastrow to Firstrow (bottom to top)
       For Lrow = Lastrow To Firstrow Step -1

       'We check the values in the F column in this example
       With .Cells(Lrow, "F")

       If Not IsError(.Value) Then

           If .Value <> "FS" Then .EntireRow.Delete
           'This will delete each row that doesn't have a Value "FS"
in Column G, case sensitive.

           End If

       End With

       Next Lrow

   End With

   ActiveWindow.View = ViewMode
   With Application
       .ScreenUpdating = True
       .Calculation = CalcMode
   End With

'Clean-up Worksheet

   For Each wks In ActiveWorkbook.Worksheets
     With wks
      myLastRow = 0
      myLastCol = 0
       Set dummyRng = .UsedRange
       On Error Resume Next
       myLastRow = _
       .Cells.Find("*", after:=.Cells(1), _
           LookIn:=xlFormulas, lookat:=xlWhole, _
           searchdirection:=xlPrevious, _
           searchorder:=xlByRows).Row
       myLastCol = _
       .Cells.Find("*", after:=.Cells(1), _
           LookIn:=xlFormulas, lookat:=xlWhole, _
           searchdirection:=xlPrevious, _
           searchorder:=xlByColumns).Column
       On Error GoTo 0

       If myLastRow * myLastCol = 0 Then
           .Columns.Delete
       Else
           .Range(.Cells(myLastRow + 1, 1), _
           .Cells(.Rows.Count, 1)).EntireRow.Delete
           .Range(.Cells(1, myLastCol + 1), _
           .Cells(1, .Columns.Count)).EntireColumn.Delete
       End If
   End With
   Next wks

' Hide Columns
   Range("A2").Select
   Columns("D:D").Select
   Selection.EntireColumn.Hidden = True
   Columns("F:K").Select
   Selection.EntireColumn.Hidden = True
   Columns("O:O").Select
   Selection.EntireColumn.Hidden = True

' Format column O with 2 decimal
   Columns("L:O").Select
   Selection.NumberFormat = "0.00"

' Resize columns widths
   Columns("A:A").Select
   Selection.ColumnWidth = 9
   Columns("B:B").Select
   Selection.ColumnWidth = 10.83
   Columns("C:C").Select
   Selection.ColumnWidth = 26.25
   Columns("E:E").Select
   Selection.ColumnWidth = 11.63
   Columns("L:L").Select
   Selection.ColumnWidth = 11.63
   Columns("M:M").Select
   Selection.ColumnWidth = 15.63
   Columns("N:N").Select
   Selection.ColumnWidth = 9.88

'Positioning
   Range("A2").Select

'Back to first sheet and positioning
   Sheets("BAU Data").Select
   Range("A2").Select

'Save file As
   Application.Dialogs(xlDialogSaveAs).Show

End Sub
Reply to this Message
Dave Peterson - 10 Nov 2007 00:27 GMT
You changed the code I suggested.

application.counta() will return a whole number 0 to whatever.

Your code is checking to see if that count is "".  That'll never happen.

So change it back to compare it to 0.

> Thanks for your response.....
>
[quoted text clipped - 455 lines]
>
> End Sub

Signature

Dave Peterson

Reply to this Message
 
Sign In
Join
My Latest Posts
My Monitored Threads
My Blog
My Photo Gallery
My Profile
My Homepage
Start New Thread
Enable EMail Alerts
Rate this Thread



©2008 Advenet LLC   Privacy Policy - Terms of Use
This website includes both content owned or controlled by Advenet as well as content owned or controlled by third parties.