[AccessD] WAY OT:Excel Q

Hi Darren,

Here is the code (it was good morning exercise!):

' Deletes empty columns of Excel.Worksheet {{rwks}}
' of an Excel.Range starting at
' {{vlngStartRow}}, {{vlngStartCol}} cell
Public Sub DropEmptyColumns( _
               ByRef rwks As Excel.Worksheet, _
               ByVal vlngStartRow As Long, ByVal vlngStartCol As Long)
Dim xlApp As Excel.Application
Dim rng As Excel.Range
Dim rngCol As Excel.Range
Dim rngAreas As Excel.Range
Dim lngColIdx As Long
Dim lngIdx As Long
Dim avar As Variant
Dim evar As Variant
Dim fEmptyColumn As Boolean
Dim rngArea As Excel.Range
    Set xlApp = rwks.Application
    ' select non-empty region
    Set rng = rwks.Cells(vlngStartRow, vlngStartCol).CurrentRegion
    If rng.Columns.Count > 0 Then
       ' for each column in selected region...
       For lngColIdx = 1 To rng.Columns.Count
          ' select column range without first (title) cell
          Set rngCol = rwks.Range( _
                       rwks.Cells(rng.Row + 1, lngColIdx), _
                       rwks.Cells(rng.Rows.Count + rng.Row + 1, lngColIdx))
          ' get column values into variant array
          avar = rngCol.Value
          fEmptyColumn = True
          ' search for not empty values in column array
          For lngIdx = LBound(avar) + 1 To UBound(avar)
            If Not IsEmpty(avar(lngIdx, 1)) Then
               ' when the first not-empty cell found
               ' set fEmptyColumn flag to False and exit cicle
               fEmptyColumn = False
               Exit For
            End If
          Next lngIdx

          If fEmptyColumn Then
             ' if column is empty add it to the area
             '  of the columns to be deleted
             Set rngCol = rwks.Columns(lngColIdx)
             If rngArea Is Nothing Then
                Set rngArea = rngCol.Areas.Item(1)
             Else
                Set rngArea = xlApp.Union(rngArea, rngCol)
             End If
          End If
       Next lngColIdx
    End If
    If Not rngArea Is Nothing Then
       ' delete empty columns' area
       rngArea.Delete
    End If
End Sub

Shamil

----- Original Message ----- 
From: "Darren DICK" <darrend at nimble.com.au>
To: "'Access Developers discussion and problem solving'" 
<accessd at databaseadvisors.com>
Sent: Tuesday, April 04, 2006 9:12 AM
Subject: [AccessD] WAY OT:Excel Q


> Hi all
> Cross Posted to dbqSQL list
> I am outputting reports to Excel from reporting services (SQL)
> The reports have many tables on them with differing column widths
> When I output the reports to Excel I find many columns with no data in 
> them
>
> Is there a way I can write some VBA and have it determine the last row on 
> the
> sheet with a value in it
> determine if there is any data in any cell from the top to the bottom - if 
> there
> is no data in the column
> delete it. Then 'tighten' all the columns?
>
> E.G. Column A has data, column B not data, column c has data
> Delete column b and move column C to the left
>
> E.G. AirCode
> For my sheet
>    find last.row with data ' that becomes the base point
>    find last.column with data ' that becomes a base point
> loop through columns & rows
>    for A to last column
>        from 1 to last row
>    if data = null then
>    delete column currentcolumn
> blah blah blah
>
> Many thanks in advance
>
> Darren
> -- 
> AccessD mailing list
> AccessD at databaseadvisors.com
> http://databaseadvisors.com/mailman/listinfo/accessd
> Website: http://www.databaseadvisors.com