How can I simplify this?

xrobc

New Member
Joined
Feb 25, 2015
Messages
20
Hi

I've managed to come up with this code:

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
 

Some videos you may like

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple

shg

MrExcel MVP
Joined
May 7, 2008
Messages
21,752
Office Version
2010
Platform
Windows
A​
B​
C​
1​
column
value
out
2​
3​
N20
3​
4​
020
4​
9​
M-RT20
5​
11​
M-RT20
6​
12​
M-RT20
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​
TT
14​
3​
LALA
15​
3​
CC

Code:
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

New Member
Joined
Feb 25, 2015
Messages
20
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

Code:
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

MrExcel MVP
Joined
May 7, 2008
Messages
21,752
Office Version
2010
Platform
Windows
Code:
Range("D2:[COLOR="#FF0000"][B]Q[/B][/COLOR]2").Resize(UBound(av1)).Value = av1
 

xrobc

New Member
Joined
Feb 25, 2015
Messages
20
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.

Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,102,692
Messages
5,488,301
Members
407,634
Latest member
ps01

This Week's Hot Topics

  • Timer in VBA - Stop, Start, Pause and Reset
    [CODE=vba][/CODE] Option Explicit Dim CmdStop As Boolean Dim Paused As Boolean Dim Start Dim TimerValue As Date Dim pausedTime As Date Sub...
  • how to updates multiple rows in muliselect listbox
    Hello everyone. I need help with below code. code is only chaning 1st row in mulitiselect list box. i know issue with code...
  • Delete Row from Table
    I am trying to delete a row from a table using VBA using a named range to find what I need to delete. My Range is finding the right cell. In the...
  • Assigning to a variable
    I have a for each block where I want to assign the value in column 5 of the found row to the variable Serv. [CODE=vba] For Each ws In...
  • Way to verify information
    Hi All, I don't know what to call this formula, and therefore can't search. I have a spreadsheet with information I want to reference...
  • Active Cell Address – Inactive Sheet
    How to use VBA to get the cell address of the active cell in an inactive worksheet and then place that cell address in a location on the current...
Top