.AutoFilter compatibility between Excel 2007 & Excel 2010/13 when dates are involved, example included

1
votes

I have a macro that I am using that is 5+ years old, I first started using it in 32bit Excel 2007 but I no longer use Excel 2007 anymore, instead I use Excel 2013 and this macro no longer works correctly...

  • Run it in Excel 2007 with regional settings set to United Kingdom or United States = Works perfectly
  • Run it in Excel 2010 or Excel 2013 with regional settings set to United Kingdom = Doesn't work
  • Run it in Excel 2010 or Excel 2013 with regional settings set to United States = Works perfectly

Problem is, I'm British so my regional settings are set to United Kingdom.

The main question is...

How can I make my macro compatible so that it can either manage with any of the regional settings OR how can I get the macro to only work with United Kingdom regional settings (date)...

The macro is supposed to match two columns using autofilters to find the matched rows and then export data from one sheet to a different sheet. I've included a sheet called "RUSHEET (CORRECT)" that has what the output should look like.

Download: https://www.dropbox.com/s/8edbk8rcp3qumfd/example.xlsm?dl=1

The macro in question is: 

Sub CROSSIMPORT()

    'Optimize'
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
        .DisplayAlerts = False
    End With

    Dim wsData As Worksheet:   Set wsData = Sheets("RASHEET")
    Dim wsList As Worksheet:   Set wsList = Sheets("RUSHEET")

    'Loads data into the array from wsList, column A to column E
    'In the beginning, columns B through E may be empty, that is fine
    Dim arrListVal As Variant: arrListVal = wsList.Range("b2", wsList.Cells(Rows.Count, "b").End(xlUp).Offset(0, 43)).Value

    Dim arrIndex As Long
    Dim rngFound As Range

    'Set Range for columns to check (both columns)
    With Intersect(wsData.UsedRange, wsData.Columns("B:C"))

        'UBound(arrListVal, 1) is the upper bound of the first dimension of the array
        'In other words, its the number of rows
        'We'll use arrIndex to go through each row
        'arrIndex starts at 1 because that's the LBound, we already set the array to go from A5 though, so no worries there
        For arrIndex = 1 To UBound(arrListVal, 1)
            'Turn AutoFilter off, test
            If .AutoFilter Then .AutoFilter
            'Filter first array (matching array column 1)
            .AutoFilter 1, arrListVal(arrIndex, 1)
            'Filter second array (matching array column 2)
            .AutoFilter 2, arrListVal(arrIndex, 2)
            On Error Resume Next

            'arrListVal(arrIndex, 1) = row arrIndex in column 1 of the array
            'Attempts to find that value in wsData, column A
            Set rngFound = .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible)
            'Set rngFound = wsData.Columns("B").Find(What:=arrListVal(arrIndex, 1), LookAt:=xlWhole)

            'If it found something, then rngFound will not be nothing
            If Not rngFound Is Nothing Then
                'Found something, fills the other columns of the array
                arrListVal(arrIndex, 36) = wsData.Range("P" & rngFound.Row).Value    'wsList column C should be wsData column I
                arrListVal(arrIndex, 37) = wsData.Range("G" & rngFound.Row).Value    'wsList column D should be wsData column O
                arrListVal(arrIndex, 38) = wsData.Range("E" & rngFound.Row).Value    'wsList column E should be wsData column K
                arrListVal(arrIndex, 39) = wsData.Range("F" & rngFound.Row).Value
                arrListVal(arrIndex, 40) = wsData.Range("X" & rngFound.Row).Value
                arrListVal(arrIndex, 43) = wsData.Range("AF" & rngFound.Row).Value
                arrListVal(arrIndex, 44) = wsData.Range("AG" & rngFound.Row).Value
                'Sets rngFound back to nothing in order to continue the loop through the array
                Set rngFound = Nothing
            Else
            End If

        Next arrIndex

        'Turning Filter Off
        .AutoFilter
    End With

    wsList.Range("B2").Resize(UBound(arrListVal, 1), UBound(arrListVal, 2)).Value = arrListVal

    'De-Optimize'
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
        .DisplayAlerts = True
    End With

End Sub
1
vbaexcelexcel-2010excel-2013
it doesn't work. << What does this mean? - David Zemens
@DavidZemens It doesn't export data, even when it should. So there is a function (the .autofilter) that isn't compatible with 2010 or onwards but is compatible with 2007. - Ryflex
Does it give you any error? - David Zemens
@DavidZemens Nope, it runs and completes but doesn't do anything; as in it finds no matches. - Ryflex
@DavidZemens It says "No cells found", here is an example I just cooked up, I've included a sheet with what the output should look like, if you run the macro on excel 2010 or later it doesn't change anything, but if you run it in excel 2007 it will end up like the sheet that's labeled "correct" dropbox.com/s/8edbk8rcp3qumfd/example.xlsm?dl=0 - Ryflex

1 Answers

0
votes

This works as expected in Excel 2010. I change the output sheet just to be sure:

enter image description here

HOWEVER, I can produce the error you describe IF I neglect to turn OFF the autofilter at the beginning of the loop. 

    For arrIndex = 1 To UBound(arrListVal, 1)
        '### Turn AutoFilter off, if it's already on:
        If .AutoFilter Then .AutoFilter

So, make sure that before you run the macro, that the sheet's filter is turned off. Otherwise, you're going to get undesired output (no output!), which is masked by your misuse of On Error Resume Next.

Here is what it looks like when I run your code unmodified except for removing the On Error Resume Next statement:

enter image description here

The only other mod I made to your code is the two lines which select one of the ranges you're having trouble with:

wsList.Activate wsList.Range("AK:AO").Select