CODEWITHSUNDEEP
excelvbafilterlarge-data
codingsnake99
codingsnake99

Reputation: 146

VBA - How to speed up the filter process

Now I am doing a project with very large-scale of data (700,000 rows * 27 column). The Problem I face now is as following:

Data Example:

Date          Category1        P&L ........ (other columns)
20180901      XXCV             123,542
20180901      ASB              4523,542
20180901      XXCV             12243,544
20180901      XXCV             12334,542
20180901      DEE              14623,5441
.
.
.

Now I have a list of new category names, and I have to replace old Name with new Name. The list looks like:

Old_name              New_Name
XXCV                  XASS
ASB                   CSS
.
.
.

The way I solved this Problem is that I loop through all old Name in the list and then filter for each one in the original data, and finally Change the old Name to new Name.

For example: First Loop is XXCV. Macro go to original data sheet and filter column "Catagory1" by XXCV. Then Change all XXCV into XASS. Macro Keep doing this until it Loop throgh all the old Name.

The Problem is!The data is too much! The filter process is very slow.

Moreover, I have 2000 old Name Need to be changed into new Name. In other word, I have to Loop 2000 times! It took me so much time to finish the whole process.

I know that doing this Task in Access could be better. However, is there any possible to Speed up this process and make it finish in 5-10 minutes?

Thanks in advance!

Edit: The codes are as follow:

Sub Mapping_Table()

    Dim row_ori_book As Long
    Dim row_fin_book As Long
    Dim original_book As Variant

    Dim sheets_name As Variant
    Dim n_sheetName As Variant
    Dim row_end As Long
    Dim col_end As Long
    Dim row_loop As Long
    Dim n_ori_book As Variant

    ' Modify book name in sheet CoC_Exp_NExp & sheet CoC UU
        Sheets("Mapping_Table").Activate
        row_ori_book = Cells(Rows.Count, "A").End(xlUp).Row
        'row_fin_book = Cells(Rows.Count, "B").End(xlUp).Row
        original_book = Range(Cells(2, "A"), Cells(row_ori_book, "A")).Value
        sheets_name = Array("CoC_Exp_NExp", "CoC_UU")

        For Each n_sheetName In sheets_name
            Sheets(n_sheetName).Activate
            row_end = Cells(Rows.Count, "A").End(xlUp).Row
            col_end = Cells(1, Columns.Count).End(xlToLeft).Column
            row_loop = 2

            For Each n_ori_book In original_book
                ActiveSheet.AutoFilterMode = False

                Range(Cells(1, 1), Cells(row_end, col_end)).AutoFilter Field:=12, Criteria1:=n_ori_book, Operator:=xlFilterValues
                On Error Resume Next
                Range(Cells(2, "L"), Cells(row_end, "L")).SpecialCells(xlCellTypeVisible).Value = Sheets("Mapping_Table").Cells(row_loop, "B").Value
                On Error GoTo 0
                row_loop = row_loop + 1
                ActiveSheet.AutoFilterMode = False
            Next n_ori_book
        Next




    End Sub

Upvotes: 0

Views: 2144

Answers (1)

StoneGiant
StoneGiant

Reputation: 1497

This does the job very quickly, but slightly differently. It will find and replace every occurence of the old name in the sheet and not just Column L. If there are other columns containing the old values and if you don't want those replaced, we may have to try something else.

This leverages the built-in find and replace as suggested by cybernetic.nomad. It scans only the rows in the remapping table instead of all the rows in the target sheets.

Sub Mapping_Table()

    Dim mapTable As Range   ' Column A (old name) maps to Column B (new name)
    Dim mapRow As Integer   ' Index for walking through map table

    Dim sheetNames As Variant  ' Array of sheet names to update
    Dim sheetName As Variant   ' Sheet name being processed

    ' Get the map table
    Set mapTable = Sheets("Mapping_Table").UsedRange

    ' Set the list of sheets to process
    sheetNames = Array("CoC_Exp_NExp", "CoC_UU")

    ' Search and replace
    For Each sheetName In sheetNames
        For mapRow = 1 To mapTable.Rows.Count
            Sheets(sheetName).Cells.Replace What:=mapTable.Cells(mapRow, 1).Text, _
                                            Replacement:=mapTable.Cells(mapRow, 2).Text, _
                                            LookAt:=xlWhole, _
                                            SearchOrder:=xlByRows, _
                                            MatchCase:=False, _
                                            SearchFormat:=False, _
                                            ReplaceFormat:=False
        Next
    Next

End Sub

Upvotes: 2

Related Questions