Home » excel » excel – VBA shortest way to check cells on containing specific text

excel – VBA shortest way to check cells on containing specific text

Posted by: admin May 14, 2020 Leave a comment

Questions:

I have some VBA code working but would like to know if there is an easier way of coding this. I have a list of 100 unique values and want to assign a category to each of the values and write the category name in another cell

I have working if-else statement that checks each value and outputs a category.

Sub AssignCategory()
Dim rng As Range
Set rng = ActiveSheet.Range("A2:A100")
For Each cell In rng.Cells
    If InStr(1, cell, "Apple") Then
        cell.Offset(0, 2).Value = "Fruit"
    ElseIf InStr(1, cell, "Racoon") Then
        cell.Offset(0, 2).Value = "Animal"
    ElseIf InStr(1, cell, "Lion") Then
        cell.Offset(0, 2).Value = "Animal"
    ElseIf InStr(1, cell, "Quartz") Then
        cell.Offset(0, 2).Value = "Mineral"
    ElseIf InStr(1, cell, "Watermelon") Then
        cell.Offset(0, 2).Value = "Fruit"
    End If
Next
End Sub

The code is working, but can I list all cells that are, for example, Animals and assign the category Animal to all of them? Instead of having 100 separate statements.

How to&Answers:

you can use something like this to check containing of the specific text in cell, if you have a list of cases then it will be more easy to maintaining:

Sub AssignCategory()
    Dim rng As Range
    Dim cell As Range, key
    Set rng = ActiveSheet.[A2:A100]
    Dim dic As Object: Set dic = CreateObject("Scripting.Dictionary")

    dic.Add "*apple*", "Fruit"
    dic.Add "*watermelon*", "Fruit"
    dic.Add "*racoon*", "Animal"
    dic.Add "*lion*", "Animal"
    dic.Add "*quartz*", "Mineral"

    For Each cell In rng.Cells
        For Each key In dic
            If LCase(cell) Like key Then
                cell.Offset(, 2).Value = dic(key)
                Exit For
            End If
        Next
    Next
End Sub

If you need to check that cell equals to specific text then use select ... case:

Sub AssignCategory2()
    Dim rng As Range
    Dim cell As Range
    Set rng = ActiveSheet.[A2:A100]

    For Each cell In rng.Cells
        Select Case LCase(cell)
            Case "apple", "watermelon": cell.Offset(, 2).Value = "Fruit"
            Case "racoon", "lion": cell.Offset(, 2).Value = "Animal"
            Case "quartz": cell.Offset(, 2).Value = "Mineral"
        End Select
    Next
End Sub

Answer:

You can try Select…case
microsoft

Answer:

A Select Case statement will allow you to stack multiple options into one result.

Sub AssignCategory()

    Dim rng As Range
    Set rng = ActiveSheet.Range("A2:A100")
    For Each cell In rng.Cells

        Select Case lcase(cell.value2)
          case "apple", "orange", "pear", "watermelon"
            cell.Offset(0, 2).Value = "Fruit"
          case "lion", "raccoon"
            cell.Offset(0, 2).Value = "Animal"
          case "quartz"
            cell.Offset(0, 2).Value = "Mineral"
          case else  'no match to anything above
            cell.Offset(0, 2).Value = "no category"
        end select

    Next cell

End Sub

BTW, the InStr is typically used to locate a sub-string inside another string. From your description, it seems you want a 1:1 direct comparison.

Answer:

for me, you can create 1 excel sheet that will be your datatable and then you can create a function to read the excel sheet and work like sql.

see example below. make sure on reference you have added microsoft activex data object library

Function getStringValue() As String

Dim cn As ADODB.Connection

Dim rs As ADODB.Recordset


strFile = Workbooks(1).FullName

strCon = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & strFile & ";Extended Properties=""Excel 8.0;HDR=Yes;IMEX=1"";"


Set cn = CreateObject("ADODB.Connection")

Set rs = CreateObject("ADODB.Recordset")


cn.Open strCon

''modify this sql statement as per your requirement

strSQL = "SELECT * FROM [Sheet1$A1:E346] where ID =1" ''Range

rs.Open strSQL, cn

getValue = rs.GetString

End Function