Another date frequency problem

pinholsm

Board Regular
Joined
Jul 12, 2007
Messages
119
I am trying to condense a sheet that has duplicate information in it due to date break ranges and frequencies

The frequencies are Monday 1 tuesday 2 etc Sunday 7. column header and row information below
Out FL Freq Eff Until
Dep Out FL Freq Eff Until
10:15 EV4085 1234567 9-Jul-07 31-Jul-07
10:15 EV4085 34 1-AUG-07 20 Aug- 07
10:15 EV4085 12 67 4-Aug-07 18-aug-07

In the above example I would like to be able to get rid of rows 3 and 4 and have row 2 10:15 EV4085 1234567 9-Jul-07 20-Aug-07

Any good way to make that happen?
 

Excel Facts

Lock one reference in a formula
Need 1 part of a formula to always point to the same range? use $ signs: $V$2:$Z$99 will always point to V2:Z99, even after copying

Boller

Banned
Joined
Apr 11, 2006
Messages
2,328
Assuming that :
- columns A:E contain your data
- the first row for each flight will always have all frequencies for that filght in column C AND will have the earliest Eff Date in column D

Then :-

Code:
Sub Test()
Application.ScreenUpdating = False
With Range([F2], [A65536].End(xlUp)(1, 6))
    .EntireRow.Sort Key1:=[B2], Order1:=xlAscending, _
        Key2:=[D2], Order2:=xlAscending, Header:=xlNo
    .FormulaR1C1 = "=IF(RC[-4]<>R[-1]C[-4],RC[-2],"""")"
    .SpecialCells(xlCellTypeFormulas, 2).FormulaR1C1 = "=R[-1]C"
    .Offset(, -2) = .Value
    .EntireRow.Sort Key1:=[B2], Order1:=xlAscending, _
        Key2:=[D2], Order2:=xlAscending, _
        Key3:=[E2], Order2:=xlDescending, _
        Header:=xlNo
    .FormulaR1C1 = "=IF(RC[-4]<>R[-1]C[-4],RC[-1],"""")"
    .SpecialCells(xlCellTypeFormulas, 2).FormulaR1C1 = "=R[-1]C"
    .Offset(, -1) = .Value
    .FormulaR1C1 = "=IF(RC[-4]<>R[-1]C[-4],1,"""")"
    .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
    .EntireColumn.Delete
End With
Application.ScreenUpdating = True
End Sub
 

pinholsm

Board Regular
Joined
Jul 12, 2007
Messages
119
Ok that is a great start, but it is deleting too much information

For example:
Dep Out FL Freq Eff Until Des1
9:44 EV4087 12345 1-Aug-07 20-Aug-07 YUL
9:44 EV4087 67 1-Aug-07 20-Aug-07 YUL

becomes:
Dep Out FL Freq Eff Until Des1
9:44 EV4087 12345 1-Aug-07 20-Aug-07 YUL

Iam looking for the freq column to convert that to 1234567 and only have 1 entry for that record
 

Boller

Banned
Joined
Apr 11, 2006
Messages
2,328
Code:
Sub Test()
Dim rng As Range, cell As Range
Application.ScreenUpdating = False
With Range([G2], [A65536].End(xlUp)(1, 7))
    .EntireRow.Sort Key1:=[B2], Order1:=xlAscending, _
        Key2:=[D2], Order2:=xlAscending, Header:=xlNo
    .FormulaR1C1 = "=IF(RC[-5]<>R[-1]C[-5],RC[-3],"""")"
    .SpecialCells(xlCellTypeFormulas, 2).FormulaR1C1 = "=R[-1]C"
    .Offset(, -3) = .Value
    .EntireRow.Sort Key1:=[B2], Order1:=xlAscending, _
        Key2:=[D2], Order2:=xlAscending, _
        Key3:=[E2], Order2:=xlDescending, _
        Header:=xlNo
    .FormulaR1C1 = "=IF(RC[-5]<>R[-1]C[-5],RC[-2],"""")"
    .SpecialCells(xlCellTypeFormulas, 2).FormulaR1C1 = "=R[-1]C"
    .Offset(, -2) = .Value
    .FormulaR1C1 = "=IF(RC[-5]<>R[-1]C[-5],1,"""")"
    With .Offset(, 1)
        .FormulaR1C1 = "=IF(R[1]C[-1]=1,RC[-5],RC[-5] &R[1]C)"
        .Value = .Value
    End With
    .SpecialCells(xlCellTypeFormulas, 2).EntireRow.Delete
End With
Set rng = Range([H2], [H65536].End(xlUp))
For Each cell In rng
    cell = UniqueNbrs(cell.Value)
    cell = SortNbrs(cell.Value)
Next
With Range([C2], [C65536].End(xlUp))
    .Value = .Offset(, 5).Value
End With
[G:H].Delete
Application.ScreenUpdating = True
End Sub

Private Function SortNbrs(origString As String) As String
Dim currentChar As String
Dim sourceNum As Integer
Dim destNum As Integer
For sourceNum = 1 To Len(origString)
currentChar = Mid(origString, sourceNum, 1)
If sourceNum = 1 Then
SortNbrs = currentChar
Else
destNum = 1
While destNum < Len(origString) And currentChar > Mid(SortNbrs, destNum, 1)
    destNum = destNum + 1
Wend
SortNbrs = Left(SortNbrs, destNum - 1) & currentChar & Mid(SortNbrs, destNum)
End If
Next sourceNum
End Function

Public Function UniqueNbrs(ByVal origString As String) As String
Dim oCol As New Collection
Dim sAns As String
Dim lCtr As Long, lCount As Long
Dim sChar As String
lCount = Len(origString)
For lCtr = 1 To lCount
    sChar = Mid(origString, lCtr, 1)
    On Error Resume Next
    oCol.Add sChar, sChar
    If Err.Number = 0 Then sAns = sAns & sChar
    Err.Clear
Next
UniqueNbrs = sAns
End Function
 

pinholsm

Board Regular
Joined
Jul 12, 2007
Messages
119
Still not working

Either I am not doing something right??? But I am getting an error.

See my info below

AC Dep Dest 1 Gate Zone Out FL Freq Eff Until
777 21:05 DXB E11 21 8 4 23-Aug-07 30-Aug-07
777 21:05 DXB E11 21 8 2 21-Aug-07 21-Aug-07
777 21:05 DXB E11 21 8 3 22-Aug-07 29-Aug-07
777 21:05 DXB E26 24 8 6 25-Aug-07 25-Aug-07
777 21:05 DXB E26 24 8 7 26-Aug-07 26-Aug-07
777 21:05 DXB E11 21 8 2 28-Aug-07 28-Aug-07


I need this consolidated down to 1 line that let's me know the frequency

Can you help? We are so close
 

Boller

Banned
Joined
Apr 11, 2006
Messages
2,328
What error are you getting and on what line of code?

The worksheet headings in your most recent post are completely different from the headings in your previous posts !! :eek:

Please post a copy of your worksheet before running the macro and a copy showing the desired results after running it.
 

Forum statistics

Threads
1,181,055
Messages
5,927,863
Members
436,573
Latest member
CMR237

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top