VBA to append 0000 to string dependent upon state

[tyantorno]

Hello All,
I was wondering if I could get some assistance. I have started some of the code but missing a vital piece.
What I have is two columns, one A with state abbreviation AL, AR etc and one with nine digit number such as 471234567. What I want to do is trim the 471234567 to 47123. I then want to append to right 0000 to replace 4567 or any of the dynamic last four digits. The numbers are dynamic e.g. 477654321, 473456712 etc. I want to perform this procedure only when state in column A = VA . Below is the code I have so far, it works but on entire column rather than if state abbreviation in column a = “VA”.
In the end would like
AL 012349876
VA 471234567
TX 441239876
To show
AL 012349876
VA 471230000
TX 441239876
[VBA]Sub TrimCellToLeft5Chars()
Dim rCell As Range
Columns("A:A").Select
Selection.NumberFormat = "000000000"
For Each rCell In Range("A1", Cells(Rows.Count, 1).End(xlUp))
rCell = Left(rCell, 5)
Next rCell
End Sub

Sub Append0000ToExistingOnRight()
Dim c As Range
Columns("A").Select
For Each c In Selection
If c.Value <> "" Then c.Value = c.Value & "0000"
Next
End Sub[/VBA]
Thank you in advance.

[sassora]

Hi
Is VBA needed here? If the code is in B1 and the state is in A1

[VBA]=IF(A1="VA", left(B1,5)&"0000",B1)[/VBA]

Then drag-copy

[tyantorno]

Hi Sassora,

I was hoping for VBA, but I want to thank you for taking time to create function. It works great, but I need to put it in a subroutine. Thanks!

[sassora]

[VBA]Sub NewCode()

Dim rCell As Range

For Each rCell In Range("A1", Cells(Rows.Count, 1).End(xlUp))

rCell.Offset(, 4).NumberFormat = "@"

If rCell.Value = "VA" Then
rCell.Offset(, 4) = Left(rCell.Offset(, 1).Value, 5) & "0000"
Else
rCell.Offset(, 4) = rCell.Offset(, 1).Value
End If

Next rCell

End Sub[/VBA]