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

Lefemmenikita

Board Regular
Joined
Jan 28, 2014
Messages
59
Office Version
  1. 2013
Platform
  1. Windows
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
AB
1CodeOutput Wanted
26571006571
3909856909856
42210002210
598521098521
Sheet1
Cell Formulas
RangeFormula
B2:B5B2=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
 

Some videos you may like

Excel Facts

What is the last column in Excel?
Excel columns run from A to Z, AA to AZ, AAA to XFD. The last column is XFD.

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
Does this do what you want?

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

Lefemmenikita

Board Regular
Joined
Jan 28, 2014
Messages
59
Office Version
  1. 2013
Platform
  1. Windows
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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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

VBA Code:
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

Board Regular
Joined
Jan 28, 2014
Messages
59
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

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

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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:
1598348051567.png


After
1598348096513.png
 

Lefemmenikita

Board Regular
Joined
Jan 28, 2014
Messages
59
Office Version
  1. 2013
Platform
  1. Windows

ADVERTISEMENT

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

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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

Board Regular
Joined
Jan 28, 2014
Messages
59
Office Version
  1. 2013
Platform
  1. Windows
I have added the version info for Excel.

The cells are formatted as general
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
Thanks for updating your profile. (y)

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.

VBA Code:
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
 

Watch MrExcel Video

Forum statistics

Threads
1,123,087
Messages
5,599,658
Members
414,325
Latest member
kfg1287

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top