Convert multiple columns from numbers to text dynamic range VBA

[silentwolf]

Hi guys

a little stuck to find the best solution to non continious columns to change from number format to text format using VBA.

This is what I got for a single Column...

Say I like to change in active sheet Column A, D, F to text

Sub ConvertNumberToText()
    With Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
    .NumberFormat = "@"
     .Value = .Value
    End With
End Sub

In the above code do I need .value = .Value?

Thanks for help

 

[Norie]

Does this work?

Sub ConvertNumberToText()
    With Intersect(Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row).EntireRow, Range("A:A, D:D, F:F"))
        Debug.Print .Address
        .NumberFormat = "@"
        .Value = .Value
    End With
End Sub

 

[fadee2]

try the following:

Sub ConvertNumberToText()
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim rng As Range

Set r1 = Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
Set r2 = Range("d2:d" & Cells(Rows.Count, 1).End(xlUp).Row)
Set r3 = Range("f2:f" & Cells(Rows.Count, 1).End(xlUp).Row)
Set rng = Union(r1, r2, r3)

    With rng
        .NumberFormat = "@"
    End With
End Sub

 

[Joe4]

One way is to use an Array to store your column letters.
The nice thing about this option is if you ever have to add or remove columns to the list, you only need add/remove them to your array.
You won't need to modify any other part of the code.

Sub ConvertNumberToText()

    Dim cols
    Dim i As Long
    Dim c As String
    Dim lr As Long
    
    cols = Array("A", "D", "F")

    For i = LBound(cols) To UBound(cols)
'       Get column letter
        c = cols(i)
'       Find last row
        lr = Cells(Rows.Count, c).End(xlUp).Row
        With Range(Cells(2, c), Cells(lr, c))
            .NumberFormat = "@"
            .Value = .Value
        End With
    Next i
    
End Sub

 

[Fluff]

Another option

Sub ConvertNumberToText()
   Dim i As Long
   Dim Ary As Variant
   Ary = Array(0, 3, 5)
   For i = 0 To UBound(Ary)
      With Range("A2:A" & Cells(Rows.Count, 1).End(xlUp).Row)
         .Offset(, Ary(i)).TextToColumns , xlDelimited, , , 0, 0, 0, 0, 0, , Array(1, 2)
      End With
   Next i
End Sub

You're code does not change the numbers to text, it just changes the format of the cell.

 

[silentwolf]

Hi guys,

did not see you..) well there is planty to choose from and I will test it sure there are all working out

Many thanks to all of you!!!

 

[abc17tg]

I have written my own and maybe someone consider it better and useful

Sub ConvertSelectedRangeToText()
       Dim rng As Range
       Set rng = selection
       
       Call ConvertRangeToText(rng)
End Sub

Sub ConvertRangeToText(rng As Range)
   On Error GoTo ErrorHandler
      
      With Application
         .ScreenUpdating = False
         .EnableEvents = False
         .Calculation = xlCalculationManual
      End With
       
       Set rng = GetUsableRange(rng)
       Dim c As Range
       For Each c In rng.Columns
            c.TextToColumns destination:=c, DataType:=xlDelimited, _
               TextQualifier:=xlTextQualifierNone, ConsecutiveDelimiter:=False, Tab:=False, _
               Semicolon:=False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 2)
       Next c
       
      With Application
         .ScreenUpdating = True
         .EnableEvents = True
         .Calculation = xlCalculationAutomatic
      End With
 Exit Sub
ErrorHandler:
       MsgBox "An error occurred while converting the range to text.", vbExclamation + vbOKOnly, "Error"
      Err.Clear
       
      With Application
         .ScreenUpdating = True
         .EnableEvents = True
         .Calculation = xlCalculationAutomatic
      End With
End Sub

Function GetUsableRange(rng As Range) As Range
    If rng Is Nothing Then
        Set GetUsableRange = Nothing
        Exit Function
    End If
    
    Dim intersection As Range
    Set intersection = Application.Intersect(rng, rng.Worksheet.UsedRange)
    
    If intersection Is Nothing Then
        Set GetUsableRange = Nothing
    Else
        Set GetUsableRange = intersection
    End If
End Function