I have some code which looks for certain words in column R thern based on a specific word it will format the numbers in column Z.

The code i have is working for the formats for Aus and Aust but not for BEL. I believe its because the format for BEL is a number format and not a text format as the rest of them are. I tried changing Format to NumberFormat but that errored out. Any idea how I can amend this.

Sub FormatNum()


Dim ws As Worksheet
Set ws = Sheets("Data")

With ws

lastrow = .Cells(.Rows.Count, "Z").End(xlUp).Row
For x = 2 To lastrow

If .Cells(x, "R") = "Aus" Then
.Cells(x, "Z") = Format(.Cells(x, "Z"), "000-00.000.000")

ElseIf .Cells(x, "R") = "Aust" Then
.Cells(x, "Z") = Format(.Cells(x, "Z"), "000-000000-000")

ElseIf .Cells(x, "R") = "Bel" Then
.Cells(x, "Z") = Format(.Cells(x, "Z"), "0000000000")

End If

Next

End With

MsgBox "Done"

End Sub

CodePudding user response：

According to useful comments, here is example how to set number format. One useful link is Excel Custom Format

Sub SetFormat()
    Dim ws As Worksheet
    Set ws = Sheets("Data")
    
    With ws
    
        lastrow = .Cells(.Rows.Count, "Z").End(xlUp).Row

        For x = 2 To lastrow
            Call SetCellFormat(.Cells(x, "R"), .Cells(x, "Z"))
        Next

    End With
    
    MsgBox "Done"
End Sub


Sub SetCellFormat(lang As Range, value As Range)
    Select Case LCase(lang.value)
        Case "aus"
            value.NumberFormat = "000\-00\.000\.000"
        Case "aust"
            value.NumberFormat = "000\-000000\-000"
        Case "bel"
            value.NumberFormat = "0000000000"
    End Select
    
End Sub

this code produces this result, but keeps data unchanged.

CodePudding user response：

Please, try the next code. It uses two arrays and, working only in memory, should be very fast even for large ranges:

Sub FormatNum()
 Dim ws As Worksheet, arr, arrFin, lastRow As Long, x As Long

Set ws = ActiveSheet ' Sheets("Data")
 lastRow = ws.cells(ws.rows.count, "Z").End(xlUp).row
 arr = ws.Range("R2:R" & lastRow).Value
 ws.Range("Z:Z").NumberFormat = "@"
 arrFin = ws.Range("Z2:ZR" & lastRow).Value

 For x = 1 To UBound(arr)
    If arr(x, 1) = "Aus" Then
         arrFin(x, 1) = Format(arrFin(x, 1), "000-00.000.000")
    ElseIf arr(x, 1) = "Aust" Then
         arrFin(x, 1) = Format(arrFin(x, 1), "000-000000-000")
    ElseIf arr(x, 1) = "Bel" Then
        arrFin(x, 1) = Format(arrFin(x, 1), "0000000000")
    End If
 Next x
 ws.Range("Z2").Resize(UBound(arrFin), 1).Value = arrFin
 MsgBox "Done"
End Sub