[AccessD] WAY OT:Excel Q

Shamil
Genius - absolute genius
Thank you sooooo much for taking the time on this
This will help things along nicely
Brilliant


Darren
------------------------------
T: 0424 696 433
 

-----Original Message-----
From: accessd-bounces at databaseadvisors.com
[mailto:accessd-bounces at databaseadvisors.com] On Behalf Of Shamil Salakhetdinov
Sent: Tuesday, 4 April 2006 6:07 PM
To: Access Developers discussion and problem solving
Subject: Re: [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 

-- 
AccessD mailing list
AccessD at databaseadvisors.com
http://databaseadvisors.com/mailman/listinfo/accessd
Website: http://www.databaseadvisors.com