cell with wrap text and merge and center

[BORUCH]

Question

if i have cell A1 and cell A2 merged together with wrapped text, and i want to increase each individual number by a certain percent how would i get that done for ex.

$100.25 ZZ
$200.25 ZA

through excel VBA

 

[BORUCH]

Select the merged cell and then run this macro...

[TABLE="width: 500"]
<tbody>[TR]
[TD]Sub IncreaseWrappedTextByCertainPercent()
  Dim X As Long, IncreaseBy As Double, Parts() As String
  IncreaseBy = 0.15  ' 15 percent
  Parts = Split(ActiveCell.Value, vbLf)
  For X = 0 To UBound(Parts)
    Parts(X) = Format((1 + IncreaseBy) * Val(Replace(Parts(X), "$", "")), "$0.00") & Mid(Parts(X), InStr(Parts(X), " "))
  Next
  Selection = Join(Parts, vbLf)
End Sub[/TD]
[/TR]
</tbody>[/TABLE]

HI

I Just realized that if i select multiple cells At once and then run the code , it doesn't do the code correctly if that can be fixed i would greatly appreciate it

Thanks

 

[Rick Rothstein]

HI

I Just realized that if i select multiple cells At once and then run the code , it doesn't do the code correctly if that can be fixed i would greatly appreciate it

Describe "it doesn't do the code correctly"... what does that mean?

 

[BORUCH]

Ok so two Problems

#1 if i select two merged and wrapped cells cells that look as follows

19.95 BX
119.70 CS

$18.64 BAR
$111.83 CS

The results will duplicate for both selected cells even though they are different numbers

#2 i would like to also be able to mround the results to 0.05 (or maybe an input box asking me the question) if possible

I'm attaching my code here that i modified a bit

Sub IncreaseWrappedTextByCertainPercent()
  Dim X As Long, askedchange As Double, Parts() As String, answer As String
  Dim answer1 As sting
  If ActiveCell.MergeCells = True And ActiveCell.WrapText = True And ActiveCell.value Like "*?" & vbLf & "?*" Then
  answer = InputBox("What percentage you want to increase?")
  'I would prefer to have this work as well answer1 = InputBox("What Penny Amount Do You Want It Rounded? ")
  askedchange = 0.01 * Val(answer)
  Parts = Split(ActiveCell.value, vbLf)
  For X = 0 To UBound(Parts)
    Parts(X) = Format((1 + askedchange) * Val(Replace(Parts(X), "$", "")), "$0.00") & Mid(Parts(X), InStr(Parts(X), " "))
  Next
  Selection = Join(Parts, vbLf)
  Else
  Exit Sub
  End If
End Sub

Thanks

 

[BORUCH]

Describe "it doesn't do the code correctly"... what does that mean?

Were you able to see the problem ?

 

[BORUCH]

Describe "it doesn't do the code correctly"... what does that mean?

any updates

 

[BORUCH]

Describe "it doesn't do the code correctly"... what does that mean?

hi

did you get a chance to look at the errors with the code ?

 

[BORUCH]

Any answers?

 

[BORUCH]

Describe "it doesn't do the code correctly"... what does that mean?

HI

When you have a chance, if you could please look at the code to fix it

thanks