Sub autoID()
Dim lastRow As Long
Dim ws As Worksheet
Set ws = ActiveSheet
On Error Resume Next
With ws
.Columns("B").SpecialCells(xlBlanks).EntireRow.Delete
.Columns("B:B").Cut
.Columns("A:A").Insert Shift:=xlToRight
.Columns("B:B").NumberFormat = "00000"
.Columns("B:B").Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
.Columns("A:A").TextToColumns Destination:=Range("A1"), DataType:=xlDelimited, _
TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
Semicolon:=False, Comma:=False, Space:=False, Other:=True, OtherChar _
:="^", FieldInfo:=Array(1, 1), TrailingMinusNumbers:=True
.Range("D2").FormulaR1C1 = _
"=IFERROR(VLOOKUP(RC1,TTW!R1:R1048576,18,FALSE),IFERROR(VLOOKUP(RC1,MMW!R1:R1048576,18,FALSE),IFERROR(VLOOKUP(RC1,TTH!R1:R1048576,18,FALSE),IFERROR(VLOOKUP(RC1,WP!R1:R1048576,18,FALSE),IFERROR(VLOOKUP(RC1,w1!R1:R1048576,18,FALSE),IFERROR(VLOOKUP(RC1,RLP!R1:R1048576,18,FALSE),""err""))))))"
lastRow = Range("A" & Rows.Count).End(xlUp).Row
.Range("D2").AutoFill Destination:=Range("D2:D" & lastRow)
.Range("E2").FormulaR1C1 = _
"=IF(AND(RC[-3]<>"""",RC[-1]>=8,RC[-1]<>""err""),1,IF(AND(RC[-3]="""",RC[-1]>=8,RC[-1]<>""err""),4,""err""))"
lastRow = Range("A" & Rows.Count).End(xlUp).Row
.Range("E2").AutoFill Destination:=Range("E2:E" & lastRow)
.Range("D:E").Copy
.Range("D:E").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
.Range("A1").Value = "P#"
.Range("B1").Value = "Excess"
.Range("C1").Value = "Item ID"
.Range("D1").Value = "QTY"
.Range("E1").Value = "New QTY"
End With
Cells.Select
ActiveWorkbook.Worksheets("ID check").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("ID check").Sort.SortFields.Add Key:=Range( _
"C2:C" & lastRow), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("ID check").Sort
.SetRange Range("A1:XF" & lastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
Call IDtoStock
Sheets("Program Start").Select
End Sub