Match Serial Number to matching Cell Number based on SN last 4# & last 2 letters

[JackHoff]

I just spent an hour making a post and its gone, I do not see how to retreive AUTO SAVED post, I will search for that info later. SO, here is the very short version.

I have a list of serial numbers (SN) on SHEET 2, Col B, maybe a few Rows to Hundreds of Rows for todays work. The format is always the same but the length is shorter or longer but the important part is the first nine digits can always be cut out to get what I need. EX: m1234567845ex, I need 45ex into another Col, then separate the numbers from the letters into two other Col. The SN may be a single number to 7 numbers but using the MID(text,9,9) gets what I need.

I use a VLOOKUP Table (2 Col) to change 10 different two letter categories into a single letter Col designation. In this case 'ex' will transfer into Col 'L'. I also need the SN 45 to go into SHEET 1 Cell L45, actually the entire SN from SHEET 2, m1234567845ex into, SHEET 1 Cell L45.

The SN's are randomized for the leading 9 digits and not important, the ending numbers and letters are required info, the 10 sets of letters will dictate which column in sheet 1 will be used and the number digits will dictate which row the entire SN will be pasted into.

Let me post this incase I have internet issues, thanks to all for any assistance on this process. Post copied to clipboard.

 

[hiker95]

JackHoff,

Sample raw data in worksheet Import:

Excel 2007
	B	C	D	E	F	G	H	I
1	IMPORT SER #	SUB SERIAL #	SERIAL #	CELL REF.	VLOOKUP	COL.CATAGORY	LOOKUP	TABLE
2	a00771129431dr						bo	A
3	a007329710140dr						br	B
4	a00477672451el						ch	C
5	a00669733170en						dr	D
6	a00447513148en						en	E
7	a0087367750pt						el	L
8	a01021771880tr						ac	H
9							mi	I
10							pt	J
11							tr	K
12
13
14
15
16
Import

After the new macro:

Excel 2007
	B	C	D	E	F	G	H	I
1	IMPORT SER #	SUB SERIAL #	SERIAL #	CELL REF.	VLOOKUP	COL.CATAGORY	LOOKUP	TABLE
2	a00771129431dr	9431dr	9431	D9431	D	dr	bo	A
3	a007329710140dr	10140dr	10140	D10140	D	dr	br	B
4	a00477672451el	2451el	2451	L2451	L	el	ch	C
5	a00669733170en	3170en	3170	E3170	E	en	dr	D
6	a00447513148en	3148en	3148	E3148	E	en	en	E
7	a0087367750pt	750pt	750	J750	J	pt	el	L
8	a01021771880tr	1880tr	1880	K1880	K	tr	ac	H
9							mi	I
10							pt	J
11							tr	K
12
13							1/09/2014 10:00 AM
14
15							a01021771880tr
16
Import

Please TEST this FIRST in a COPY of your workbook (always make a backup copy before trying new code, you never know what you might lose).

Option Explicit
Sub CopyImportSerialNbrsV3()
' hiker95, 01/09/2013, ME748764
Dim lrb As Long, lrc As Long, c As Range
With Sheets("Import")
  .Activate
  lrb = .Cells(Rows.Count, 2).End(xlUp).Row
  If lrb = 1 Then
    MsgBox "There are no 'IMPORT SER#'s in column B - macro terminated!"
    Exit Sub
  End If
  Application.ScreenUpdating = False
  lrc = .Cells(Rows.Count, 3).End(xlUp).Row
  If lrc > 1 Then
    .Range("C2:G" & lrc).ClearContents
  End If
  lrb = .Cells(Rows.Count, 2).End(xlUp).Row
  .Range("C2:C" & lrb).FormulaR1C1 = "=MID(RC[-1],9,9)"
  .Range("D2:D" & lrb).FormulaR1C1 = "=MID(RC[-1],1,LEN(RC[-1])-2)"
  .Range("G2:G" & lrb).FormulaR1C1 = "=RIGHT(RC[-5],2)"
  .Range("F2:F" & lrb).FormulaR1C1 = "=VLOOKUP(RC[1],R1C8:R11C9,2,0)"
  .Range("E2:E" & lrb).FormulaR1C1 = "=RC[1]&RC[-1]"
  With .Range("C2:G" & lrb)
    .Value = .Value
  End With
  For Each c In .Range("E2", .Range("E" & Rows.Count).End(xlUp))
    If c <> "" Then
      Sheets("Asian dB").Range(c).Value = c.Offset(, -3).Value
    End If
  Next c
  With .Range("H13:I13")
    .ClearContents
    .MergeCells = True
    .HorizontalAlignment = xlCenter
  End With
  With .Range("H13")
    .FormulaR1C1 = "=NOW()"
    .NumberFormat = "m/dd/yyyy hh:mm AM/PM"
    .Value = .Value
  End With
  With .Range("H15:I15")
    .ClearContents
    .MergeCells = True
    .HorizontalAlignment = xlCenter
  End With
  .Range("H15") = .Range("B" & lrb)
  .Columns(8).ColumnWidth = 10
  .Columns(9).ColumnWidth = 10
End With
Application.ScreenUpdating = True
End Sub

Before you use the macro with Excel 2007 or newer, save your workbook, Save As, a macro enabled workbook with the file extension .xlsm

Then run the CopyImportSerialNbrsV3 macro.