VBA: Add formula to a cell's string using VBA

[Lefemmenikita]

HI

I am exporting a 6 digit number from a system into Excel. When this is pasted into excel, this is reformatted as a number instead of being left as a text value.

Column A with the code shows what the reformatted number looks like. Column B shows what I want it to look like.

Book1
	A	B
1	Code	Output Wanted
2	6571	006571
3	909856	909856
4	2210	002210
5	98521	098521
Sheet1

Cell Formulas
Range	Formula
B2:B5	B2	=REPT(0,6-LEN(A2))&A2

This is ok when the range of the reformatted cells remains the same and/or I am able to use a helper column like column B to insert a formula.

However, the reformatted numbers are not always in the same place and I am not always able to insert another column to insert a formula.

What I was wanting was a macro which allows me to reformat only the selected active cells.

e.g. If I select cell A4, I want VBA to insert a formula similar to =REPT(0,6-LEN(activecell.value))&Activecell.value

I have seen this done with 'round' formulas though I don't know how to adapt this to my current requirements.

Thanks

 

[Peter_SSs]

Does this do what you want?

Sub ReformatNumbers()
  With Selection
    .NumberFormat = "@"
    .Value = Evaluate("right(rept(0,6)&" & .Address & ",6)")
  End With
End Sub

 

[Lefemmenikita]

Thank You Peter_SSs, That is definitely what I want.

Is there a way to tweak this slightly though so that if you select a range, it does that for every cell in the range?

I tried selecting multiple cells, though it copies the value from the first cell to the others in a range

 

[Peter_SSs]

It should work for multiple cells if they are in a contiguous selection.
Do you you mean that you want to select several disjoint ranges?

If so, try this one

Sub ReformatNumbers_v2()
  Dim rng As Range
  
  For Each rng In Selection.Areas
    With rng
      .NumberFormat = "@"
      .Value = Evaluate("right(rept(0,6)&" & .Address & ",6)")
    End With
  Next rng
End Sub

 

[Lefemmenikita]

Thanks. That works without copying the same cell value into all cells, if I select each cell individually (CTRL + click).

For contiguous cells, it copies the first cell value down the range .

Is that supposed to do that?

 

[Peter_SSs]

For contiguous cells, it copies the first cell value down the range .

Is that supposed to do that?

No, and it does not do that for me.

For example, before:

After

 

[Lefemmenikita]

That's really weird.
I am highlighting the range and running the macro and am getting the following result

 

[Peter_SSs]

So far I have not been able to reproduce that.

1. Please refer to the 3rd bullet point in my signature block below.

2, Before you run the code, what is the cell format of A3:A4 (eg General, Text, Number etc)?

 

[Lefemmenikita]

I have added the version info for Excel.

The cells are formatted as general

 

[Peter_SSs]

Thanks for updating your profile.

The cells are formatted as general

My setup is the same as that and I have not been able to reproduce the behaviour you showed in post 7.

You could try this version which does each cell individually.

About how many rows of data will you be selecting? If it is a very large number of rows then we might look at another way still.

Sub ReformatNumbers_v3()
  Dim rng As Range
  
  Application.ScreenUpdating = False
  For Each rng In Selection
    With rng
      .NumberFormat = "@"
      .Value = Evaluate("right(rept(0,6)&" & .Address & ",6)")
    End With
  Next rng
  Application.ScreenUpdating = True
End Sub