How can I simplify this?

[xrobc]

Hi

I've managed to come up with this code:

    Dim v, i As Long
    v = Range("D2:Q" & Range("D" & Rows.Count).End(xlUp).Row).Value
    '
    For i = 1 To UBound(v)
        'N Is 20
        If Left(v(i, 3), 1) = "N" Then
            v(i, 2) = "20"
        End If
        '0 = 20
        If v(i, 4) = "0" Then
        v(i, 2) = "20"
        End If
        
'       M-RT = Op20
        If (Left(v(i, 9), 4) = "M-RT") Then
            v(i, 2) = "20"
        End If
'       M-RT = Op20
        If (Left(v(i, 11), 4) = "M-RT") Then
            v(i, 2) = "20"
        End If
'       M-RT = Op20
        If (Left(v(i, 13), 4) = "M-RT") Then
            v(i, 2) = "20"
        End If


'       (Area5) = Op20
        If (Left(v(i, 10), 7) = "(AREA5)") Then
            v(i, 2) = "20"
        End If
        If (Left(v(i, 12), 7) = "(AREA5)") Then
            v(i, 2) = "20"
        End If
        If (Left(v(i, 14), 7) = "(AREA5)") Then
            v(i, 2) = "20"
        End If
        
'      (Area 7) = Op20
        If (Left(v(i, 10), 7) = "(AREA7)") Then
            v(i, 2) = "20"
        End If
        If (Left(v(i, 12), 7) = "(AREA7)") Then
            v(i, 2) = "20"
        End If
        If (Left(v(i, 14), 7) = "(AREA7)") Then
            v(i, 2) = "20"
        End If
        
        'T not added
        If Left(v(i, 3), 1) = "T" Then
            v(i, 2) = "T"
        End If
        'LA not added
        If Left(v(i, 3), 2) = "LA" Then
            v(i, 2) = "LA"
        End If
        'C not added
        If Left(v(i, 3), 1) = "C" Then
            v(i, 2) = "C"
        End If


    Next i
    
    Range("D2:E2").Resize(UBound(v)).Value = v

Its using the array to analyse some data and set a value (typically using the number 20) based on that data.

There's quite a few different rules analysing different things that ultimately do the same thing.

I would like to simplify this code and perhaps pick up some of the rules from cells on a worksheet (in another array?). But I don't know where to start.

Thanks

 

[shg]

	A​	B​	C​
1​	column​	value​	out​
2​	3​	N	20
3​	4​	0	20
4​	9​	M-RT	20
5​	11​	M-RT	20
6​	12​	M-RT	20
7​	10​	(AREA5)	20
8​	12​	(AREA5)	20
9​	14​	(AREA5)	20
10​	10​	(AREA7)	20
11​	12​	(AREA7)	20
12​	14​	(AREA7)	20
13​	3​	T	T
14​	3​	LA	LA
15​	3​	C	C

Sub xrobc()
  Dim av1           As Variant
  Dim av2           As Variant
  Dim i             As Long
  Dim j             As Long

  av1 = Range("D2", Cells(Cells(Rows.Count, "D").End(xlUp).Row, "Q")).Value
  av2 = Range("A2", Cells(Rows.Count, "C").End(xlUp))
  '
  For i = 1 To UBound(av1)
    For j = 1 To UBound(av2)
      If Left(av1(i, av2(j, 1)), Len(av2(j, 2))) = av2(j, 2) Then av1(i, av2(j, 1)) = av2(j, 3)
    Next j
  Next i
End Sub

 

[xrobc]

Thanks, I think that I can just about follow what's happening.

Because all of my original formula are nearly identical, you have replace the values that change with variables.

However, when I try to write that back with

Range("D2:E2").Resize(UBound(av1)).Value = av1

Nothing appears to happen. It looks like it is overwriting like with like, when I look in the locals window the value of av1(i,2) is Empty.

 

[shg]

Range("D2:[COLOR="#FF0000"][B]Q[/B][/COLOR]2").Resize(UBound(av1)).Value = av1

 

[xrobc]

That makes sense, just write over the whole lot. Should have seen that one, but I'm not really an expert on this yet.

I changed the formula to get the write back in the correct place as it was overwriting the lookup value.

If Left(av1(i, av2(j, 1)), Len(av2(j, 2))) = av2(j, 2) Then av1(i, 2) = av2(j, 3)

One other observation was that is didn't like the value of 0 in position B3 of the table, but when I tried with a different character it work perfectly.

Thanks