Split zip code in a column into 2 columns

Question

This is what my end result should look like. If there is not the four digits to move over to the second column then fill with 4 zeros.

How can I split zip code in a column into 2 columns and fill empty cells in column 2 if first column has only 5 digits?

Here is what I have been working with

Dim ws As Worksheet
Dim cell As Range

Set ws = Worksheets("sheet1")

For Each cell In ws.Range("K2:K500").Cells
    cell.Offset(0, 1).Value = Left(cell.Value, 5)
Next cell
   
Dim cel As Range, rngC As Range, rngB As Range
Dim lastRowA As Long, lastRowB As Long

With ws
    lastRowK = .Cells(.Rows.Count, "K").End(xlUp).Row 'last row of column A
    lastRowL = .Cells(.Rows.Count, "L").End(xlUp).Row 'last row of column B
    For Each cel In .Range("K2:K" & lastRowL)   'loop through column L
        'check if cell in column A exists in column B
        If WorksheetFunction.CountIf(.Range("K2:K" & lastRowL), cel) = 0 Then
            cel.Offset(0, 3).Value = Right(cel.Value, 4)
            '.Range("M" & cel.Row) = Right(cell.Value, 4)
        Else
            .Range("M" & cel.Row) = "0000"
        End If
    Next
End With

Answer 1

One of the simplest ways to solve this problem is to supplement the original string with a large number of zeros and take the values ​​of the first and second five characters for two cells:

Sub setZIPandZeros()
    Const TEN_ZEROS = "0000000000"    ' 10 times
    
    Dim ws As Worksheet
    Dim cell As Range
    Dim sLongString As String
    
    Set ws = Worksheets("Sheet1")
    
    For Each cell In ws.Range("K2:K" & ws.Cells(ws.Rows.Count, "K").End(xlUp).Row).Cells
        sLongString = Trim(cell.Text) & TEN_ZEROS
        cell.Offset(0, 1).Resize(1, 2).NumberFormat = "@"
        cell.Offset(0, 1).Resize(1, 2).Value = Array(Left(sLongString, 5), _
            Mid(sLongString, 6, 5))
    Next cell
End Sub

Update The modified code is much faster and gives a result that more closely matches the description of the task:

Sub setZipZeros()
    Dim ws As Worksheet
    Dim rResult As Range
    Set ws = Worksheets("Sheet1")
    
    ' Addressing R1C1 is used in the formulas - If the original range
    ' is shifted to another column, you will need to change the letter
    ' of the column "K" only in this line
    Set rResult = ws.Range("K2", ws.Cells(ws.Rows.Count, "K").End(xlUp)).Offset(0, 1)
    
    ' If the columns L:M are already in text format, then instead of
    ' the results we will get the texts of formulas
    rResult.Resize(, 2).NumberFormat = "General"
    
    ' These two lines do most of the work:
    rResult.Formula2R1C1 = "=LEFT(TRIM(RC[-1])&""00000"",5)"
    rResult.Offset(0, 1).Formula2R1C1 = "=MID(TRIM(RC[-2])&""000000000"",6,4)"
    
    ' We don't know if auto-recalculation mode is on now
    ' Application.Calculation = xlAutomatic
    ActiveSheet.Calculate
    Set rResult = rResult.Resize(, 2)
    
    ' Set the text format for the cells of the result
    ' to prevent conversions "00123" to "123"
    rResult.NumberFormat = "@"
    
    ' Replace formulas with their values
    rResult.Value = rResult.Value
End Sub

Answer 2

In case you want to bypass VBA and use formulas, you can do this.

Cell B2:

    =LEFT(A2,5)

Cell C2:

    =IF(LEN(A2)=9,RIGHT(A2,4),"0000")