Sub CheckOrderMacro()
Worksheets("Paste Order Data Here").Select
Dim Colnum As Integer
Dim prefix As String
Dim suffix As String
Dim x As Long
Dim RestrictLst As Variant
Dim LastRow As Long
Dim Sht As Worksheet
Set Sht = ThisWorkbook.Worksheets("Export Restricted List")
LastRow = Sht.Cells(Sht.Rows.Count, "A").End(xlUp).Row
RestrictLst = Range("'Export Restricted List'!A1:A" & LastRow).Value
Set Sht = ThisWorkbook.Worksheets("Paste Order Data Here")
Range("C1").Select
For x = 1 To 100
If UCase(Cells(1, x)) = "CASE CODE" Then
Colnum = x - 1
Exit For
End If
Next
For x = 1 To 1000
If Mid(Range("T1:T1000").Cells(x), 6, 1) = "-" Then
prefix = Mid(Range("T1:T1000").Cells(x), 1, 5)
End If
If Cells(x, Colnum + 1) <> "" And Len(Trim(Range("D1:D1000").Cells(x))) = 5 Then
Cells(x, Colnum) = CStr(prefix & Cells(x, Colnum + 1))
If Mid(Range("D1:D1000").Cells(x), 6, 1) = "-" Then
suffix = Mid(Range("D1:D1000").Cells(x), 7, 5)
Cells(x, Colnum) = CStr(prefix & suffix)
Else: Cells(x, Colnum) = CStr(prefix & Cells(x, Colnum + 1))
If Range("D1:D1000").Cells(x) = "**********" Then
Cells(x, Colnum) = CStr(Cells(x, Colnum + 1))
End If
End If
End If
Next
For x = 1 To 1000
If Mid(Range("T1:T1000").Cells(x), 6, 1) = "-" Then
prefix = Mid(Range("T1:T1000").Cells(x), 1, 5)
End If
If Cells(x, Colnum + 1) <> "" And Len(Trim(Range("D1:D1000").Cells(x))) = 4 Then
Cells(x, Colnum) = CStr(prefix & "0" & Cells(x, Colnum + 1))
End If
Next
For x = 1 To 1000
If Mid(Range("T1:T1000").Cells(x), 6, 1) = "-" Then
prefix = Mid(Range("T1:T1000").Cells(x), 1, 5)
End If
If Cells(x, Colnum + 1) <> "" And Len(Trim(Range("D1:D1000").Cells(x))) = 10 Then
Cells(x, Colnum) = Cells(x, Colnum + 1)
End If
Next
For x = 1 To 1000
If Mid(Range("T1:T1000").Cells(x), 6, 1) = "-" Then
prefix = Mid(Range("T1:T1000").Cells(x), 1, 5)
End If
If Cells(x, Colnum + 1) <> "" And Len(Trim(Range("D1:D1000").Cells(x))) = 11 Then
Cells(x, Colnum) = Mid(Trim(Range("D1:D1000").Cells(x)), 1, 5) & Mid(Trim(Range("D1:D1000").Cells(x)), 7, 5)
End If
Next
For x = 1 To 1000
Range("V1:V1000").Cells(x) = "=VLOOKUP(RC[-19],'Export Restricted List'!C[-21]:C[-21],1,FALSE)"
Range("W1:W1000").Cells(x) = "=VLOOKUP(RC[-20],'Export Restricted List'!C[-22]:C[-15],5,FALSE)"
Range("X1:X1000").Cells(x) = "=VLOOKUP(RC[-21],'Export Restricted List'!C[-23]:C[-15],6,FALSE)"
Range("Y1:Y1000").Cells(x) = "=VLOOKUP(RC[-22],'Export Restricted List'!C[-24]:C[-15],7,FALSE)"
Next
Range("V1") = "On Restricted List"
Range("W1") = "Export Variant"
Range("X1") = "On Promo List"
Range("Y1") = "Restriction Begins"
Range("V2:Y500").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Selection.Replace What:="#N/A", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Selection.Replace What:="1/0/1900", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Application.CutCopyMode = False
Range("W2:Y500").Select
Selection.Replace What:="0", Replacement:="", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Range("D1").Select
MsgBox ("Order Check is complete. Please review results.")
End Sub