Inläsning av textfil till Excel.

Hej!

Jag har problem med summeringar av kolumn projekt och finans.

Så här ser kolumnrubrikerna ut:
KONTO KST VERK FINANS MP PROJ Pub/BELOPP

Jag vill alltså ha summering så fort PROJ och FINANS ändras.

Med den här koden fungerar summering av PROJ, men inte finans.

Vad kan det vara för fel?

Sub Inläsning_projekt_fil()
'
' Inläsning_projekt_fil Makro
' Makrot inspelat 2004-02-16 av
'
' Kortkommando: Ctrl+i
'
Dim i As Integer
Dim j As Integer
i = 2
j = 2
 chosenfile = Application.GetOpenFilename("text-filer (*.prn), *.prn")
If chosenfile <> False Then
    MsgBox "Öppnar " & chosenfile
    Do
        lngIndex = InStr(chosenfile, "\")
        If lngIndex = 0 Then Exit Do
      chosenfile = Right$(chosenfile, Len(chosenfile) - lngIndex)
   Loop
Workbooks.OpenText chosenfile, Origin:=xlWindows, _
        StartRow:=1, DataType:=xlFixedWidth, FieldInfo:=Array(Array(0, 1), Array(18, 1), Array(39, 1), Array(51, 1), Array(79, 1), Array(92, 1), _
        Array(110, 1)), TrailingMinusNumbers:=True

    Columns("A:G").Select
    Selection.Sort Key1:=Range("D2"), Order1:=xlAscending, Key2:=Range("F2") _
        , Order2:=xlAscending, Header:=xlGuess, _
        OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom
    Range("A3").Select
    Columns("A:A").ColumnWidth = 8.71
    Columns("A:A").EntireColumn.AutoFit
    Columns("E:E").ColumnWidth = 8.71
    Columns("E:E").EntireColumn.AutoFit
    Columns("F:F").ColumnWidth = 11.6
    Columns("G:G").ColumnWidth = 13#
    Columns("G:G").Select
    Selection.NumberFormat = "#,##0.00_ ;[Red]-#,##0.00 "
    Range("A1").Select
While Not IsEmpty(ActiveSheet.Cells(j, 6))
While ActiveSheet.Cells(i, 6).Value = ActiveSheet.Cells(j, 6).Value
i = i + 1
Wend
Rows(i).Insert
Cells(i, 1) = "Summa projekt"
Cells(i, 7).FormulaR1C1 = "=SUM(R[" & j - i & "]C:R[-1]C)"
i = i + 1
j = i
'ActiveSheet.HPageBreaks.Add before:=Cells(i, 1)
Wend
i = 2
j = 2
While Not IsEmpty(ActiveSheet.Cells(j, 4))
While ActiveSheet.Cells(i, 4).Value = ActiveSheet.Cells(j, 4).Value
i = i + 1
Wend
Rows(i).Insert
Cells(i, 1) = "Summa finans"
Cells(i, 7).FormulaR1C1 = "=SUM(R[" & j - i & "]C:R[-1]C)"
i = i + 1
j = i
Wend
End If
End Sub

Skulle vara väldigt TACKSAM för hjälp.