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

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

Thank you in advance.

 

[NoS]

Hi tyantorno

I try something along the lines of this

Sub Alter_Numbers()
    Dim Lrow As Long
    Dim States As Range
    Dim cel As Range
    
    With ActiveSheet
    
        Lrow = .Cells(.Rows.Count, "A").End(xlUp).Row
        
        Set States = Range("A1:A" & Lrow)
        
        For Each cel In States
            If cel.Value = "VA" Then
                'do the thing over in col C so you can tell
                cel.Offset(0, 2).Value = Left(cel.Offset(0, 1).Value, 5) & "0000"
            End If
        Next cel
    End With
        
End Sub

 

[tyantorno]

Hello Nos,

Thank you that works great. I set offset to 1 to have in same column, Thanks again for sharing. Have a great day.:clap2: