1) put the code below (ChangePartNumbers) in the workbook with the Conversion
worksheet in it.
2) make any needed changes to the macro as described in the comments that
are in the macro.
3) make sure the workbook with the Conversion worksheet in it is open.
4) pull up a .csv file
5) run the macro 'ChangePartNumbers'
'/===============================================/
' Sub Purpose: lookup new parts #s and replace old parts #s
' by deleting the old parts #s column
'
' Method- Inserts a column to the right of the column with
' the old part#s in it. Puts a vlookup formula in
' the column to the right of the column with the
' old part#s in it. If the vlookup can not find a
' new parts #, a blank is inserted.
' Copies that formula to the
' bottom of the worksheet and makes it a value.
' Deletes the old part#s column.
'
' *** indicates areas you might want to change the macro
'
Public Sub ChangePartNumbers()
Dim dblLastRow As Double
Dim strAddress As String
On Error GoTo err_Sub
'find last row in worksheet
dblLastRow = ActiveSheet.Cells.SpecialCells(xlLastCell).Row
' save location of current cell
strAddress = ActiveCell.Address
'- - - - - - - - - - - - - - -
'*** insert a column to the left of the column with the
' part#s in it. Change <<<("C:C")>>> to whatever column has
' the part#s in it.
Columns("C:C").Offset(0, 1).Insert Shift:=xlToRight
'- - - - - - - - - - - - - - -
'*** change <<<("D1")>>> to the column to the left of the column
' that has the part#s in it.
Range("D1").Select
ActiveCell.Formula = "NEW PART #S"
'- - - - - - - - - - - - - - -
'*** change <<<("D2")>>> to the column to the left of the column
' that has the part#s in it.
Range("D2").Select
'- - - - - - - - - - - - - - -
'*** change <<<VLOOKUP(C2>>> to whatever column has
' the part#s in it.
'*** change <<<[Book1.xls]>>> to the workbook with the Conversion
' worksheet in it
'*** change <<<Sheet1>>> to the worksheet name of the Conversion
' worksheet
'*** change <<<$B:$C>>> to the columns in the Conversion worksheet
' where the Old part#s / New part#s are located
'*** assuming that the New part#s column is located immediately
' to the right of the Old part#s column, therefore the
' <<<2>>> in <<<$B:$C,2,FALSE>>> does not need to be changed
ActiveCell.Formula = "=IF(ISNA(VLOOKUP(C2," & _
"[Book1.xls]Sheet1!$B:$C,2,FALSE)),"""",VLOOKUP(C2," & _
"[Book1.xls]Sheet1!$B:$C,2,FALSE))"
'- - - - - - - - - - - - - - -
Selection.Copy
'- - - - - - - - - - - - - - -
'*** change <<<"D2
">>> to the column to the left of the column
' that has the part#s in it.
Range("D2
" & dblLastRow).Select
'- - - - - - - - - - - - - - -
ActiveSheet.Paste
Application.CutCopyMode = False
'- - - - - - - - - - - - - - -
'*** change <<<("D
")>>> to the column to the left of the column
' that has the part#s in it.
Columns("D
").Select
'- - - - - - - - - - - - - - -
Selection.Copy
Selection.PasteSpecial Paste:=xlValues, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
'- - - - - - - - - - - - - - -
'*** change <<<("C:C")>>> to whatever column has the part#s in it.
Columns("C:C").Select
'- - - - - - - - - - - - - - -
Application.CutCopyMode = False
'- - - - - - - - - - - - - - -
'*** delete the line of code below if you do NOT want to delete the
' old part#s column
Selection.Delete Shift:=xlToLeft
'- - - - - - - - - - - - - - -
Range(strAddress).Select
exit_Sub:
On Error Resume Next
Exit Sub
err_Sub:
Debug.Print "Error: " & Err.Number & " - (" & _
Err.Description & _
") - Sub: ChangePartNumbers - " & Now()
Resume exit_Sub
End Sub
'/===============================================/
HTH,