Help identifying key fields only in XLS

[dencarter]

Hi guys -

Just been reading through these forums and thought there might be someone on here that can help - I've been tearing my hair out trying to find a solution to this little problem of mine!

The excel spreadsheet I work with details the amount of revenue flight attendants have taken on a their flights between two specified dates. I run this every week and the detail looks like the attached (just without the yellow bits and with about 4000 individual entries in total).

http://orangespirit.zymichost.com/incentive report example.xls

The bits I've highlighted yellow are the staff members' base, name and their average Spend Per Head in the period. The sample here is just a two day example, so you can imagine that over a week or a month there are a lot more flights.

I am trying to find a way to produce a worksheet that only includes the three columns: Base, Name and SPH (the yellow bits) so I can publish it weekly. Right now I have to do it manually which is a mammoth task that takes hours every week.

I'm sure there must be a way to extract this information more quickly and efficiently - I just haven't been able to find it...

The problem I always encounter is that for every employee there can be anything from one to twenty rows of individual flight data before the total.

Sorry if this makes no sense, but if anyone can point me in the right direction you'll be saving my sanity!

Cheers
Den

 

[jbeaucaire]

Try this on a copy of your sheet:

Option Explicit

Sub ReformatReport()
'Jerry Beaucaire   4/20/2010
Dim delRNG  As Range
Dim LastRw  As Long
Dim CrewRw  As Long
Dim SPH     As Double

'speed up macro
    Application.ScreenUpdating = False
'delete unneeded columns
    Range("B:C,E:G").Delete xlShiftToLeft
'delete unneeded rows
    Range("C8:C" & Rows.Count).SpecialCells(xlCellTypeBlanks).EntireRow.Delete xlShiftUp
'define rows of data
    LastRw = Range("B" & Rows.Count).End(xlUp).Row + 1
'clear extra data below that
    Rows(LastRw + 1 & ":" & LastRw + 100).Clear

'seed the delete range for the end
    Set delRNG = Range("A" & LastRw + 100)

'evaluate data set and get SPH number into the first row for each crew member
    For CrewRw = LastRw To 8 Step -1
        If Cells(CrewRw, "B") = "" Then
            SPH = Cells(CrewRw, "C")
            Set delRNG = Union(delRNG, Cells(CrewRw, "A"))
        ElseIf Cells(CrewRw - 1, "B") = "" Or CrewRw = 8 Then
            Cells(CrewRw, "C") = SPH
        Else
            Set delRNG = Union(delRNG, Cells(CrewRw, "A"))
        End If
    Next CrewRw

'delete extra rows and clear the delete range variable
    delRNG.EntireRow.Delete xlShiftUp
    Set delRNG = Nothing

Application.ScreenUpdating = True
End Sub

I found the main listing of employees at the bottom of your sample sheet and ran it after moving that data back up to row 8, it completed in about 60 seconds.

 

[jbeaucaire]

Thanks for your response to my post earlier today. You are an absolute superstar. It works like a dream and I can't thank you enough!

I shouldn't really have left all that company data on the bottom of the XLS (Ooops!) but I'm glad I forgot to delete it so you could help.

I am honestly very grateful.

Thanks again

Gald to help. That was fun to write.