assign a number in a new cell based on certain characters in another

[asd1011]

Hi Everyone, I am new to this forum and havent done much with VBA other than in college but i remember the basics and am excited to play with it again

i am scanning QR codes into excel and want to have it automatically decode some parts of the code.

eg. 1234asdfgh is the code that i scanned.

1 23 = produced in January on the 23rd
4 = produced in mexico
a = made in 2010 (b=2011, c=2011, d=2012...)
s = produced on machine #8
dfgh = unique serial number


when i scan the code, id like it to automatically populate another cell with the year of production based on the code. it would be very useful if it could shade the cell a different color to for easy and quick recognition.

Could i get some help with this?

 

[mumps]

It could probably be tidied up a bit but try this macro.

Sub GetYear()
    Application.ScreenUpdating = False
    Dim bottomN As Long
    bottomN = Range("N" & Rows.Count).End(xlUp).Row
    Dim rng As Range
    Dim yr As String
    For Each rng In Range("N1:N" & bottomN)
        yr = Mid(rng, 5, 1)
            Select Case yr
                Case "a"
                    rng.Offset(0, -2) = 2000
                Case "b"
                    rng.Offset(0, -2) = 2001
                Case "c"
                    rng.Offset(0, -2) = 2002
                Case "d"
                    rng.Offset(0, -2) = 2003
                Case "e"
                    rng.Offset(0, -2) = 2004
                Case "f"
                    rng.Offset(0, -2) = 2005
                Case "g"
                    rng.Offset(0, -2) = 2006
                Case "h"
                    rng.Offset(0, -2) = 2008
                Case "i"
                    rng.Offset(0, -2) = 2009
                Case "j"
                    rng.Offset(0, -2) = 2010
                Case "k"
                    rng.Offset(0, -2) = 2011
                Case "l"
                    rng.Offset(0, -2) = 2012
                Case "m"
                    rng.Offset(0, -2) = 2013
                Case "n"
                    rng.Offset(0, -2) = 2014
                Case "o"
                    rng.Offset(0, -2) = 2015
                Case "p"
                    rng.Offset(0, -2) = 2016
                Case "q"
                    rng.Offset(0, -2) = 2017
                Case "r"
                    rng.Offset(0, -2) = 2018
                Case "s"
                    rng.Offset(0, -2) = 2019
                Case "t"
                    rng.Offset(0, -2) = 2020
            End Select
    Next rng
    Application.ScreenUpdating = True
End Sub

 

[Fluff]

Another macro approach, using Rick' formula & one of his UDF'

Sub Clr()
    Dim Cnt As Long
    
    For Cnt = 1 To Range("N1").End(xlDown).Row
        With Range("L" & Cnt)
            .Formula = "=1945 + CODE(UPPER(Mid(rc[2], 5, 1)))"
            .Interior.ColorIndex = Right(.Value, 2)
            .Font.Color = TextColorToUse(.Interior.Color)
            End With
    Next Cnt
End Sub

Function TextColorToUse(BackColor As Long) As Long
'  This function returns the color to use for
'  text to make it readable on a dark background
'  Created by Rick Rothstein
  Dim Luminance As Long
  Luminance = 77 * (BackColor Mod &H100) + _
              151 * ((BackColor \ &H100) Mod &H100) + _
              28 * ((BackColor \ &H10000) Mod &H100)
  '  Default value of TextColorToUse is 0-Black, set
  '  it to White if the Luminance is less than 32640
  If Luminance < 32640 Then TextColorToUse = vbWhite
End Function

If your dates start at 2000 then change the line below as shown in red

 .Interior.ColorIndex = Right(.Value, 2)[COLOR=#ff0000]+3[/COLOR]

 

[Rick Rothstein]

Another macro approach, using Rick' formula...

Still wonder about the answer to the question I asked of the OP back in Message #6 ... if the "a" in the code represents 2010 and based on what the OP posted in Message #4 , namely that his date range was 2000 to 2020, what characters are used for the years 2000 to 2009? It is possible that if the OP references a date before 2010, that my formula will fail. The OP needs to clear this up for us.