Extracting Country Names from Cell Values This fairly clunky looking VBA script successfully pulls names of countries from an Array, but could it be made shorter?

Mass of text from Column C onward in each row may contain the names of countries, which I want to pull into the corresponding cell in row A. What I have so far is not pretty...

Sub PullCountries()
Dim Rng As Range
Dim Block As Range
Dim i As Long
i = 1

Dim LastRow As Long
LastRow = Range("B1").End(xlDown).Row

While i &lt;= LastRow
Set Rng = Range("B" &amp; i)
Set Block = Rows(i)

Range("I1").Value = i

If InStr(1, Range("C" &amp; i), "Canada") Or InStr(1, Range("D" &amp; i), "Canada") Or InStr(1, Range("E" &amp; i), "Canada") Then
Rng.Offset(0, -1).Value = "Canada"
i = i + 1
ElseIf InStr(1, Range("C" &amp; i), "United States") Or InStr(1, Range("D" &amp; i), "United States") Or InStr(1, Range("E" &amp; i), "United States") Then
Rng.Offset(0, -1).Value = "United States"
i = i + 1
ElseIf InStr(1, Range("C" &amp; i), "Britian") Or InStr(1, Range("D" &amp; i), "Britian") Or InStr(1, Range("E" &amp; i), "Britian") Then
Rng.Offset(0, -1).Value = "UK"
i = i + 1
ElseIf InStr(1, Range("C" &amp; i), "UK") Or InStr(1, Range("D" &amp; i), "UK") Or InStr(1, Range("E" &amp; i), "UK") Then
Rng.Offset(0, -1).Value = "UK"
i = i + 1
ElseIf InStr(1, Range("C" &amp; i), "Spain") Or InStr(1, Range("D" &amp; i), "Spain") Or InStr(1, Range("E" &amp; i), "Spain") Then
Rng.Offset(0, -1).Value = "Spain"
i = i + 1
ElseIf InStr(1, Range("C" &amp; i), "Portugal") Or InStr(1, Range("D" &amp; i), "Portugal") Or InStr(1, Range("E" &amp; i), "Portugal") Then
Rng.Offset(0, -1).Value = "Portugal"
i = i + 1
ElseIf InStr(1, Range("C" &amp; i), "Ireland") Or InStr(1, Range("D" &amp; i), "Ireland") Or InStr(1, Range("E" &amp; i), "Ireland") Then
Rng.Offset(0, -1).Value = "Ireland"
i = i + 1
ElseIf InStr(1, Range("C" &amp; i), "Japan") Or InStr(1, Range("D" &amp; i), "Japan") Or InStr(1, Range("E" &amp; i), "Japan") Then
Rng.Offset(0, -1).Value = "Japan"
i = i + 1
ElseIf InStr(1, Range("C" &amp; i), "Greece") Or InStr(1, Range("D" &amp; i), "Greece") Or InStr(1, Range("E" &amp; i), "Greece") Then
Rng.Offset(0, -1).Value = "Greece"
i = i + 1
ElseIf InStr(1, Range("C" &amp; i), "Italy") Or InStr(1, Range("D" &amp; i), "Italy") Or InStr(1, Range("E" &amp; i), "Italy") Then
Rng.Offset(0, -1).Value = "Italy"
i = i + 1

ElseIf Application.WorksheetFunction.CountA(Rng.Offset(0, 1)) = 0 Then
i = i + 1

Else: i = i + 1
End If
Wend
End Sub


Obviously, this isn't pretty. And given that the task is very repetitive, I reckon it could be made shorter. If this is possible, how could I start.

Furthermore, would it be possible to pull from an array of countries pre-prepared in another worksheet, and refer to that instead of inserting the actual names into the code, as is done here? And finally, if a range contained more than one country, how could I expand the code to pull that information too?
The small(er) things before we tackle the elephant in the room:

Naming

Your names aren't terrible, but could be a lot better. However, whatever you name things, you should comply with standard naming conventions. To wit:


  Local Variables: Written in camelCase.  
  
  Dim localVariable As String
  includes method arguments. 
  
  Module / Global Variables: Written in PascalCase.  
  
  Private ModuleVariable As String
  Global PublicVariable As Long  
  
  Method Names: Verbs. Written in PascalCase  
  
  Private Function ReturnThisValue() As Long
  Public Sub DoThisThing() 
  
  Constants: Written in SHOUTY_SNAKE_CASE  
  
  Public Const CONSTANT_VALUE As String = "This Value Never Changes"  


Also, Block is declared and set but never used. It should be removed.



Don't use :

Just don't. Keep your instructions on separate lines. They're too easy to miss and violate too many conventions.



Put things in Variables

Range("C" &amp; i)


You see this? This is telling Excel to go and find that range. Every time you write it. What if you want to check a different column? Right now, you'll have to rewrite the declaration on 20 different lines.

Instead, put it in a variable then just reference the Variable. Now, if the variables need to change, you only have to change them in 1 place, and the rest takes care of itself.

Dim cCell As Range, dCell As Range, eCell As Range
Set cCell = Range("C" &amp; i)
Set dCell = Range("D" &amp; i)
Set eCell = Range("E" &amp; i)

Dim countryName As String

countryName = "Canada"
If Instr(1, cCell, countryName) Or Instr(1, dCell, countryName) Or Instr(1, eCell, countryName) Then
...
...




Don't Repeat Yourself

Also known as DRY. Take your i = i + 1 statement. That is always going to happen. So why write it 20 times when you can just put it at the start or end of your loop?

While i &lt;= lastRow

    Code
    Code
    Code

    ...

    i = i + 1

Wend


Boom. 12 lines of code gone



And now the big stuff:

Refactoring

Refactoring is the process of splitting one big thing into many little things. 
Any time you find yourself copy-pasting code, you should be thinking "Hmm, this can probably be turned into a method of some kind". 



1st Refactoring

This check:

If Instr(1, cCell, countryName) Or Instr(1, dCell, countryName) Or Instr(1, eCell, countryName) Then


Can be a Separate Method Like so:

Public Function NameIsInRange(ByVal searchName As String, ByRef range1 As Range, range2 As Range, range3 As Range) As Boolean

    Dim result As Boolean
    result = InStr(1, range1, searchName) Or InStr(1, range2, searchName) Or InStr(1, range3, searchName)

    NameIsInRange = result

End Function


And now we're down to:

Sub PullCountries()

    Dim i As Long
    i = 1

    Dim LastRow As Long
    LastRow = Range("B1").End(xlDown).Row

    While i &lt;= LastRow

        Dim resultRange As Range
        Set resultRange = Range("A" &amp; i)

        Dim cCell As Range, dCell As Range, eCell As Range
        Set cCell = Range("C" &amp; i)
        Set dCell = Range("D" &amp; i)
        Set eCell = Range("E" &amp; i)

        If NameIsInRange("Canada", cCell, dCell, eCell) Then
        resultRange = "Canada"

        ElseIf NameIsInRange("United States", cCell, dCell, eCell) Then
        resultRange = "United States"

        ElseIf NameIsInRange("Britian", cCell, dCell, eCell) Then
        resultRange = "UK"

        ElseIf NameIsInRange("UK", cCell, dCell, eCell) Then
        resultRange = "UK"

        ElseIf NameIsInRange("Spain", cCell, dCell, eCell) Then
        resultRange = "Spain"

        ElseIf NameIsInRange("Portugal", cCell, dCell, eCell) Then
        resultRange = "Portugal"

        ElseIf NameIsInRange("Ireland", cCell, dCell, eCell) Then
        resultRange = "Ireland"

        ElseIf NameIsInRange("Japan", cCell, dCell, eCell) Then
        resultRange = "Japan"

        ElseIf NameIsInRange("Greece", cCell, dCell, eCell) Then
        resultRange = "Greece"

        ElseIf NameIsInRange("Italy", cCell, dCell, eCell) Then
        resultRange = "Italy"

        End If

        i = i + 1

    Wend

End Sub

Public Function NameIsInRange(ByVal searchName As String, ByRef range1 As Range, range2 As Range, range3 As Range) As Boolean

    Dim result As Boolean
    result = InStr(1, range1, searchName) Or InStr(1, range2, searchName) Or InStr(1, range3, searchName)

    NameIsInRange = result

End Function




2nd Refactoring

The only things that actually change in the loop are the name to check and the name to output. So, why don't we make those a list? For an iterable list with more than 1 element per line, I'd use an Array. 

Let's make a new sheet and give it the codename wsCountryNames. Then a function to get the table and pass it to an Array:



Public Function GetCountryNamesTable() As Variant

    With wsCountryNames

        Dim topLeftCell As Range
        Set topLeftCell = .Cells(1, 1) '/ "A1"

        Dim finalRow As Long
        finalRow = .Cells(.Rows.Count, topLeftCell.Column).End(xlUp).Row

        Dim tableWidth As Long
        tableWidth = 2

        Dim tableRange As Range
        Set tableRange = .Range(topLeftCell, Cells(finalRow, topLeftCell.Column + tableWidth - 1))

    End With

    GetCountryNamesTable = tableRange

End Function


The value in Cell A1 is now in GetCountryNamesTable(1, 1), A2, (2, 1), B1, (1, 2) etc.

Now, we can just iterate through your list:

Sub PullCountries()

    Dim i As Long, j As Long
    i = 1

    Dim LastRow As Long
    LastRow = Range("B1").End(xlDown).Row

    Dim namesList As Variant
    namesList = GetCountryNamesTable

    Dim searchName As String, displayName As String

    While i &lt;= LastRow

        Dim resultRange As Range
        Set resultRange = Range("A" &amp; i)

        Dim cCell As Range, dCell As Range, eCell As Range
        Set cCell = Range("C" &amp; i)
        Set dCell = Range("D" &amp; i)
        Set eCell = Range("E" &amp; i)

        For j = LBound(namesList, 1) + 1 To UBound(namesList, 1) '/ +1 for header row
            searchName = namesList(j, 1)
            displayName = namesList(j, 2)

            If NameIsInRange(searchName, cCell, dCell, eCell) Then
                resultRange = displayName
                Exit For '/ We found our result so we can terminate the loop early
            End If

        Next j

        i = i + 1

    Wend

End Sub

Public Function NameIsInRange(ByVal searchName As String, ByRef range1 As Range, range2 As Range, range3 As Range) As Boolean

    Dim result As Boolean
    result = InStr(1, range1, searchName) Or InStr(1, range2, searchName) Or InStr(1, range3, searchName)

    NameIsInRange = result

End Function

Public Function GetCountryNamesTable() As Variant

    With wsCountryNames

        Dim topLeftCell As Range
        Set topLeftCell = .Cells(1, 1) '/ "A1"

        Dim finalRow As Long
        finalRow = .Cells(.Rows.Count, topLeftCell.Column).End(xlUp).Row

        Dim tableWidth As Long
        tableWidth = 2

        Dim tableRange As Range
        Set tableRange = .Range(topLeftCell, Cells(finalRow, topLeftCell.Column + tableWidth - 1))

    End With

    GetCountryNamesTable = tableRange

End Function




3rd Refactoring

I'm going to put your search range in an Array:

Public Function GetSearchRange() As Variant

    With (codename of your sheet here, call it wsSearchSheet for now)

        Dim topLeftCell As Range
        Set topLeftCell = .Cells(1, 1) '/ "A1"

        Dim finalRow As Long
        finalRow = .Cells(.Rows.Count, 2).End(xlUp).Row '/ "2" for "B" column

        Dim finalCol As Long
        finalCol = 5 '/ "E" column

        Dim tableRange As Range
        Set tableRange = .Range(topLeftCell, Cells(finalRow, finalCol))

    End With

    GetCountryNamesTable = tableRange

End Function


And Re-Jig the IsInRange function to deal with an array value instead:

Public Function ValueContainsString(ByVal valueToSearch As Variant, ByVal searchString As String) As Boolean

    ValueContainsString = InStr(1, CStr(valueToSearch), searchString)

End Function


And implement these changes to the main sub:

Option Explicit

Sub PullCountries()

    Dim i As Long, j As Long, k As Long

    Dim namesList As Variant
    namesList = GetCountryNamesTable

    Dim searchNameCol As Long, displayNameCol As Long
    searchNameCol = 1
    displayNameCol = 2

    Dim searchArray As Variant
    searchArray = GetSearchValues

    Dim searchStartCol As Long, searchEndCol As Long
    searchStartCol = 3
    searchEndCol = 5

    Dim outputCol As Long
    outputCol = 1

    Dim foundMatch As Boolean

    Dim valueToSearch As Variant
    Dim searchName As String, displayName As String

    For i = LBound(searchArray, 1) To UBound(searchArray, 1)
        foundMatch = False

        For j = searchStartCol To searchEndCol
            valueToSearch = searchArray(i, j)

                For k = LBound(namesList, 1) + 1 To UBound(namesList, 1) '/ +1 for header row
                    searchName = namesList(k, searchNameCol)

                    If ValueContainsString(valueToSearch, searchName) Then
                        displayName = namesList(k, displayNameCol)
                        searchArray(i, outputCol) = displayName
                        foundMatch = True
                        Exit For '/ We found our result so we can terminate the loop early
                    End If
                Next k

            If foundMatch Then Exit For
        Next j
    Next i

    '/ Read output back to sheet. 
    For i = LBound(searchArray, 1) To UBound(searchArray, 1)
        Range("A" &amp; i) = searchArray(i, outputCol)
    Next i

End Sub

Public Function ValueContainsString(ByVal valueToSearch As Variant, ByVal searchString As String) As Boolean

    ValueContainsString = InStr(1, CStr(valueToSearch), searchString)

End Function

Public Function GetCountryNamesTable() As Variant

    With wsCountryNames

        Dim topLeftCell As Range
        Set topLeftCell = .Cells(1, 1) '/ "A1"

        Dim finalRow As Long
        finalRow = .Cells(.Rows.Count, topLeftCell.Column).End(xlUp).Row

        Dim tableWidth As Long
        tableWidth = 2

        Dim tableRange As Range
        Set tableRange = .Range(topLeftCell, Cells(finalRow, topLeftCell.Column + tableWidth - 1))

    End With

    GetCountryNamesTable = tableRange

End Function

Public Function GetSearchValues() As Variant

    With (codename of your sheet here, call it wsSearchSheet for now)

        Dim topLeftCell As Range
        Set topLeftCell = .Cells(1, 1) '/ "A1"

        Dim finalRow As Long
        finalRow = .Cells(.Rows.Count, 2).End(xlUp).Row '/ "2" for "B" column

        Dim finalCol As Long
        finalCol = 5 '/ "E" column

        Dim tableRange As Range
        Set tableRange = .Range(topLeftCell, Cells(finalRow, finalCol))

    End With

    GetSearchValues = tableRange

End Function


Want to change your country names? Just change the values in your table. Your data moves about? Just change the GetSearchValues targets. You can extend either as far as you like.

Total number of values you now have to change in your code: Maybe 10. And then only if your sheet data moves around positions.



Codenames Addendum

Codenames are big and clever. Every worksheet and workbook has a "name" that the user can see and change.

MyCurrentWB.Worksheets("Country Names")  

is referencing a sheet name.

A Codename on the other hand is a secret name that can only be set/changed in the IDE. 



the name in brackets is the "name". The name not in brackets is the "codename". It is set in the properties window.



If you give a sheet a codename then the user can change the name as much as they like, all you have to do is use

wsCountryNames.Cells()  

in your code and it will keep running.