Convert Excel Array formula into VBA code

Question

I have two set of range named as LIST_KEY and LIST_CAT. In Column A, user will add some data which will contain one of the one of the text from LIST_KEY. I would like to get corresponding Category list from LIST_CAT depends upon the Key value

I am using below VBA code to achieve this. This include a Array formula.

Sub match()

Dim ss As Workbook

Dim test As Worksheet

Set ss = Excel.Workbooks("test.xlsm")
Set test = ss.Worksheets("Sheet1")

For i = 2 To test.Cells(Rows.Count, "A").End(xlUp).Row

Cells(i, "B").FormulaArray = "=INDEX(LIST_CAT,MATCH(TRUE,ISNUMBER(SEARCH(LIST_KEY,RC[-1])),0))"

Cells(i, "B").Formula = Cells(i, "B").Value

Next i

End Sub

This code works perfect if there is less data to fetch. But in my original use case, I will have around 8000 rows. Due to this large number of columns excel will go to not responding state after 2-3 minutes.

Instead of adding Array formula to column B, Is there anyway to convert that into VBA to run this faster. Sorry, I am new to this VBA stuff and dont have much experience

Can you say more about the structure of the text in column A and the structure of the keys? Can the key be extracted from the text? For example, is their a regular expression for the key? Doing a whole-text search for 8000 strings against a possibly large list of keys does not seem efficient. — John Coleman
– John Coleman, Commented Apr 25, 2020 at 14:20

user6585761 · Accepted Answer · 2020-04-25 14:31:28Z

Try the following code, which uses arrays instead of worksheet formulas...

Option Explicit

Sub GetCategories()

    Dim sourceWorkbook As Workbook
    Set sourceWorkbook = Workbooks("test.xlsm")

    Dim sourceWorksheet As Worksheet
    Set sourceWorksheet = sourceWorkbook.Worksheets("Sheet1")

    Dim lookupArray As Variant
    lookupArray = sourceWorkbook.Names("LIST_KEY").RefersToRange.Value

    Dim returnArray As Variant
    returnArray = sourceWorkbook.Names("LIST_CAT").RefersToRange.Value

    Dim tableArray As Variant
    Dim lastRow As Long
    With sourceWorksheet
        lastRow = .Cells(.Rows.Count, "a").End(xlUp).Row
        tableArray = .Range("A2:B" & lastRow).Value
    End With

    Dim desc As String
    Dim i As Long
    Dim j As Long
    For i = LBound(tableArray, 1) To UBound(tableArray, 1)
        desc = tableArray(i, 1)
        For j = LBound(lookupArray, 1) To UBound(lookupArray, 1)
            If InStr(1, desc, lookupArray(j, 1), vbTextCompare) > 0 Then
                tableArray(i, 2) = returnArray(j, 1)
                Exit For
            End If
        Next j
    Next i

    sourceWorksheet.Range("B2").Resize(UBound(tableArray, 1), 1).Value = Application.Index(tableArray, 0, 2)

End Sub

Collectives™ on Stack Overflow

Convert Excel Array formula into VBA code

1 Answer 1

Comments

Your Answer

Hot Network Questions

Collectives™ on Stack Overflow

1 Answer 1

Comments

Your Answer

Sign up or log in

Post as a guest

Related