Macro: if column contains any number of possible strings, add zeros to front of number in that column

[sndameron]

I have a column that contains numbers whose leading zeros disappeared thanks to importing into excel. I want to reduce the number of steps this involves so I really don't want to open it in some other program to fix it then import. I'm already running a macro on this for something else, and would love to just add a little bit of script into it to fix this issue. So, I need a macro written that will look at the column with say a header name of ID. If the adjacent column called NAME is any of the following text: apple, orange, banana, blueberry, then add zeros to the beginning of the numbers of column ID so that its total digits is 9. If it does not match criteria, keep it at whatever number is already in the adjacent cell. It would be great if it could just replace the number in the ID column, but I'm okay if it gets moved to another column if that makes it simpler. For example:

ID	NAME	CONVERT TO
1234	banana	000001234
45	cucumber	45
9876	orange	000009876
343	apple	000000343

<tbody>
</tbody>

 

[footoo]

Try this :

Sub FT()
Dim ray: ray = Array("apple", "banana", "orange")
Dim rng As Range: Set rng = Range([B1], Cells(Rows.Count, "B").End(xlUp))
Rng.AutoFilter Field:=1, Criteria1:=ray, Operator:=xlFilterValues
rng.SpecialCells(xlCellTypeVisible).NumberFormat = "000000000"
rng.AutoFilter
End Sub

 

[footoo]

Amended :

Sub FT()
Dim ray: ray = Array("apple", "banana", "orange")
Dim rng As Range: Set rng = Range([B1], Cells(Rows.Count, "B").End(xlUp))
Rng.AutoFilter Field:=1, Criteria1:=ray, Operator:=xlFilterValues
rng.Offset(0,-1).SpecialCells(xlCellTypeVisible).NumberFormat = "000000000"
rng.AutoFilter
End Sub