Dim Datastart As String ' User Input Starting Data Cell
Sub Extract()
Dim theText As String ' the value
Dim dataStart As String ' user input starting data cell
Dim dataEnd As String ' user input ending data cell
Dim dataOut As String ' output starting output cell
Dim thisRow As Integer, thisCol As Integer ' user input row and column
Dim rowEnd As Integer,colEnd As Integer ' user input ending row and column
Dim rowOut As Integer, colOut As Integer ' output row and column
Dim answer As String ' the result
On Error GoToEndProgram:
Do While True
dataStart = InputBox("Type the first cell of the data input range", "First Data Cell")
thisRow = Range(dataStart).Row
thisCol = Range(dataStart).Column
dataEnd = InputBox("Type the last cell of the data input range", "Last Data Cell")
rowEnd = Range(dataEnd).Row
colEnd = Range(dataEnd).Column
dataOut = InputBox("Type the cell where you want the output to start.", "Output Data Cell")
rowOut = Range(dataOut).Row
colOut = Range(dataOut).Column
Do Until thisRow = (rowEnd + 1)
' Assume there is no match
answer = "No Lot ID"
' Get the value and remove leading or trailing spaces
theText = Trim(Cells(thisRow, thisCol))
' Perform the first test
If Test1(theText) Then
' There is a LotID
If MoreThanOne(theText) Then
answer = "Multiple Lot IDs"
Else
answer = theText
End If
Else
' Perform the second test
If Test2(theText) Then
answer = theText
End If
End If
If answer = theText And Not foundALot Then
foundALot = True
End If
' Write the answer
Cells(rowOut, colOut) = answer
' Go to the next row
thisRow = thisRow + 1
rowOut = rowOut + 1
Loop
Loop
EndProgram:
End Sub
' This is the first test to see if there is a Lot ID.
' @param theText {String) - text to check
' @returns True if it passes the Lot ID test or False otherwise
Function Test1(theText As String) As Boolean
Dim char1 As String, char2 As String, char3 As String, lastChar As String, charAfter As String
Test1 = False
' Get the first and third characters
char1 = Left(theText, 1)
char3 = Mid(theText, 3, 1)
charAfter = Mid(theText, 6, 1)
If (char1 = "0" Or char1 = "1" Or char1 = "2") And char3 = "-" And (Len(theText) = 9) Or Not (IsNumeric(charAfter)) Then
' We have 0?- or 1?- or 2?- and no extra digit after a 9-character match so it passes
Test1 = True
End If
End Function
' This is the second test to see if there is a Lot ID.
' The test looks for 20##P
' @paramtheText (String) - text to check
' @returns True if it passes the test or False otherwise
Function Test2(theText As String) As Boolean
Dim char12 As String
Test2 = False
' Get the first two characters
char12 = Left(theText, 2)
If char12 = "20" Then
' Check for number then number then uppercase or lowercase "P"
If IsNumeric(Mid(theText, 3, 1)) And IsNumeric(Mid(theText, 4, 1)) And UCase(Mid(theText, 5, 1)) = "P" Then
Test2 = True
End If
End If
End Function
' This function attempts to identify if more than one LotID is in the field.
' The string that gets passed to it has already been identified as containing a LotID.
' This function checks if the character following the Lot ID is NOT numeric and that
' there is a dash somewhere in the remainder of the string. This avoids identifying
' input with seven digits after the "-" as being multiple Lot IDs.
' @paramtheText (String) - text to search
' @returns True if more than one LotID is in the input and False otherwise.
Function MoreThanOne(theText As String) As Boolean
Dim charAfter As String
MoreThanOne = False
If Len(theText) > 9 Then
' Get last character after LotID
charAfter = Mid(theText, 6, 1)
If (Not IsNumeric(charAfter)) And InStr(1, theText, "-", vbTextCompare) > 0 Then
MoreThanOne = True
End If
End If
End Function