A few variations of how I might do it....
Code: Select all
Option Explicit
Sub kkk() ' https://eileenslounge.com/viewtopic.php?f=30&t=35966
Dim arr() As Variant
Dim arr1() As Variant
Dim i As Long, k As Long, m As Long
Let arr() = Array("ll", 500, 100, 2500, 250)
Let arr1() = Array("mm", 15025, 3325, 6565, 3333)
Let k = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(3).Row
For i = 2 To k
If Worksheets("Sheet1").Cells(i, 1) <> "" Then
If IsError(Application.Match(Worksheets("Sheet1").Range("A" & i), arr(), 0)) Then ' test for the error
' Do what you want to do when no match is found
Else
Let m = Application.Match(Worksheets("Sheet1").Range("A" & i), arr(), 0) - 1
Let Worksheets("Sheet1").Cells(i, 2) = arr1(m)
End If
End If
Next i
End Sub
Sub kkk2() '
Dim arr() As Variant
Dim arr1() As Variant
Dim i As Long, k As Long, m As Long, En As Variant ' A variant can be a number or a vbError
Let arr() = Array("ll", 500, 100, 2500, 250)
Let arr1() = Array("mm", 15025, 3325, 6565, 3333)
Let k = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(3).Row
For i = 2 To k
If Cells(i, 1) <> "" Then
Let En = Application.Match(Worksheets("Sheet1").Range("A" & i), arr(), 0)
If IsError(En) Then ' test for the error
' Do what you want to do when no match is found
Else
Let m = En - 1
Let Worksheets("Sheet1").Cells(i, 2) = arr1(m)
End If
End If
Next i
End Sub
Sub kkk3() ' forgetting the m
Dim arr() As Variant
Dim arr1() As Variant
Dim i As Long, k As Long, En As Variant ' A Variant can be a number or a vbError
Let arr() = Array("ll", 500, 100, 2500, 250)
Let arr1() = Array("mm", 15025, 3325, 6565, 3333)
Let k = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(3).Row
For i = 2 To k
If Cells(i, 1) <> "" Then
Let En = Application.Match(Worksheets("Sheet1").Range("A" & i), arr(), 0)
If IsError(En) Then ' test for the error
' Do what you want to do when no match is found
Else
Let Worksheets("Sheet1").Cells(i, 2) = arr1(En - 1)
End If
End If
Next i
End Sub
Sub kkk4() ' ..." .. i don't thing so that two if are required iserror can handle both error one if cell is blank and if match not found!...."...
Dim arr() As Variant
Dim arr1() As Variant
Dim i As Long, k As Long, En As Variant ' A Variant can be a number or a vbError
Let arr() = Array("ll", 500, 100, 2500, 250)
Let arr1() = Array("mm", 15025, 3325, 6565, 3333)
Let k = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(3).Row
For i = 2 To k
Let En = Application.Match(Worksheets("Sheet1").Range("A" & i), arr(), 0)
If IsError(En) Then ' test for the error
' Do what you want to do when no match is found
Else
Let Worksheets("Sheet1").Cells(i, 2) = arr1(En - 1)
End If
Next i
End Sub
'
Sub kkk5() '
Dim arr() As Variant
Dim arr1() As Variant
Dim i As Long, k As Long, En As Variant ' A Variant can be a number or a vbError
Let arr() = Array("ll", 500, 100, 2500, 250)
Let arr1() = Array("mm", 15025, 3325, 6565, 3333)
Let k = Worksheets("Sheet1").Cells(Worksheets("Sheet1").Rows.Count, 1).End(3).Row
For i = 2 To k
Let En = Application.Match(Worksheets("Sheet1").Range("A" & i), arr(), 0)
If Not IsError(En) Then Let Worksheets("Sheet1").Cells(i, 2) = arr1(En - 1)
Next i
End Sub
Sub kkk6() '
Dim i As Long, k As Long, En As Variant ' A Variant can be a number or a vbError
Dim arr() As Variant, arr1() As Variant
Let arr() = Array("ll", 500, 100, 2500, 250)
Let arr1() = Array("mm", 15025, 3325, 6565, 3333)
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item("Sheet1")
Let k = Ws1.Cells(Ws1.Rows.Count, 1).End(3).Row
For i = 2 To k
Let En = Application.Match(Ws1.Range("A" & i), arr(), 0)
If Not IsError(En) Then Let Ws1.Cells(i, 2) = arr1(En - 1)
Next i
End Sub
'
Sub kkk7() '
Dim i As Long, k As Long, En As Variant ' A Variant can be a number or a vbError
Dim arr() As Variant, arr1() As Variant
Let arr() = Array("ll", 500, 100, 2500, 250)
Let arr1() = Array("mm", 15025, 3325, 6565, 3333)
With ThisWorkbook.Worksheets.Item("Sheet1") ' http://web.archive.org/web/20190628052028/http://excelmatters.com/2017/02/28/whos-with-me/
Let k = .Cells(.Rows.Count, 1).End(3).Row
For i = 2 To k
Let En = Application.Match(.Range("A" & i), arr(), 0)
If Not IsError(En) Then Let .Cells(i, 2) = arr1(En - 1)
Next i
End With
End Sub