Working well but then I moved to Excell 2007

[MAButler]

My workbook has a very large and growing number of rows, with a number of different codes doing all sorts of things. I had this working well but then I moved to Excel 2007, and now it has a problem........ Saved as .xlsm just stops and nothing works or if working it is very very very slow. When saved as .xls [Compatibility Mode) everything works except the following code.<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o></o>
I have debugged and I can see it copies the data to the new workbook (Columns A through to J), it puts the search parameters in the right cells (X2, Y2 and Z2) and actions the advance filter...... but only the column titles come over.. no data.. <o></o>
<o></o>
I have tried just "StartDate" and "Format(StartDate, "mm/dd/yyyy")" neither works.......... the date format in number of ways....but still no data...

Back with my old excel it worked so what am i doing wrong or should I be doing it another way......

Public StartDate
Public EndDate
Public AccountNumber
Public CancelProcess As Boolean
 
Public Sub SearchDataJournal()
   Load frmGetJournal
   frmGetJournal.Show
 
   If CancelProcess Then Exit Sub
 
Dim ResultRowCount As Long
Const AccountColumn As Integer = 1
Const DateColumn As Integer = 10
Const DirectoryToSaveIn As String = "C:\Test\"
Application.ScreenUpdating = False
Dim shtActive As Worksheet
 
    Set shtActive = ActiveSheet
    With Workbooks.Add.Worksheets(1)
        shtActive.Cells.Copy
        .Range("A1").PasteSpecial xlPasteValues
        Application.DisplayAlerts = False
        Do While .Parent.Sheets.Count > 1
            .Parent.Sheets(.Parent.Sheets.Count).Delete
        Loop
        Application.DisplayAlerts = True
    End With
 
' Set up Criteria for advanced filter
Range("X1").Value = Cells(1, AccountColumn).Value
Range("Y1").Value = Cells(1, DateColumn).Value
Range("Z1").Value = Cells(1, DateColumn).Value
Range("X2").Value = AccountNumber
'Range("Y2").Value = ">=" & StartDate
Range("Y2").Value = ">=" & Format(StartDate, "mm/dd/yyyy")
'Range("Z2").Value = "<=" & EndDate
Range("Z2").Value = ">=" & Format(EndDate, "mm/dd/yyyy")
' Apply Advanced Filter
Columns("$A:$J").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("$X$1:$Z$2"), CopyToRange:=Range("$AA$1"), Unique:=False
 
...... the code goes on and on

 

[MAButler]

Bump - anyone

 

[Sektor]

Application.ScreenUpdating = False

 

[MAButler]

I have already got that in the code!

 

[MAButler]

rewriten the code but its so slow

Public StartDate
Public EndDate
Public AccountNumber
Public CancelProcess As Boolean
Public Sub SearchDataJournal()
   Load frmGetJournal
   frmGetJournal.Show
 
   If CancelProcess Then Exit Sub
 
Dim ResultRowCount As Long
Const DirectoryToSaveIn As String = "C:\Test\"
'Application.ScreenUpdating = False
Dim shtActive As Worksheet
 
    Set shtActive = ActiveSheet
 
    With Workbooks.Add.Worksheets(1)
        shtActive.Cells.Copy
        .Range("A1").PasteSpecial xlPasteValues
        .Range("J:J").NumberFormat = "mm/dd/yyyy"
        .Range("A:J").AutoFilter
        .Range("A:J").AutoFilter Field:=10, Criteria1:=">=" & Format(StartDate, "mm/dd/yyyy"), _
         Operator:=xlAnd, Criteria2:="<=" & Format(EndDate, "mm/dd/yyyy")
        .Range("A:J").AutoFilter Field:=1, Criteria1:=AccountNumber
        .Range("A:J").Copy
        .Range("AA1").Select
        ActiveSheet.Paste
        Selection.AutoFilter
        .Range("A:AC").Delete
        .Range("A:A").Cut Destination:=Range("R:R")
        .Range("R:R").NumberFormat = "000000"
        .Range("C:C").Cut Destination:=Range("J:J")
        .Range("J:J").NumberFormat = "0.00"
        .Range("F:F").Cut Destination:=Range("I:I")
        .Range("A:H").Clear
 
    Rows("1:1").Delete Shift:=xlUp
 
    End With
ResultRowCount = Cells.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
RunningTotal = 0
For Each TheNum In Columns("J:J").SpecialCells(xlCellTypeConstants, 1)
If TheNum.NumberFormat = "0.00" Then
TheNum.Offset(0, 1).Value = 40
TheNum.Offset(0, 5).Value = 600000
RunningTotal = RunningTotal + TheNum.Value
End If
LastRow = TheNum.Row
Next TheNum
Cells(LastRow + 1, "J").Value = RunningTotal
Cells(LastRow + 1, "K").Value = 50
Cells(LastRow + 1, "L").Value = 600000
Cells(LastRow + 1, "O").Value = 600000
Cells(LastRow + 1, "R").Value = "Revokes Vehicle"
Cells(LastRow + 1, "I").Value = 541032
Range("A1").Value = "DFT"
Range("B1").Value = "6000"
Range("C1").Value = "ZA"
Range("D1").Value = "GBP"
Range("E1").Value = "MIKE"
Range("F1").Value = "MIKE"
Range("G1").Value = Format(EndDate, "dd.mm.yy")
Range("H1").Value = Format(Date, "dd.mm.yy")
Range("P1").Value = "MTA_0001"
Range("A:R").EntireColumn.HorizontalAlignment = xlLeft
Range("B:B").EntireColumn.HorizontalAlignment = xlRight
Range("I:O").EntireColumn.HorizontalAlignment = xlRight
 
 
'ResultRowCount = Cells.Find("*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
' Save File New Name
Filename = AccountNumber & Format(StartDate, "mmmyy") & ".xls"
ActiveWorkbook.SaveAs Filename:=DirectoryToSaveIn & Filename
ActiveWorkbook.Close
Application.ScreenUpdating = True
'Inform user of results
ln1 = "Location : " & DirectoryToSaveIn & vbNewLine
ln2 = "FileName : " & Filename & vbNewLine
ln3 = "Row Count: " & ResultRowCount & vbNewLine
msg = ln1 & ln2 & ln3
pt = MsgBox(msg, vbInformation, "Process Complete")
End Sub