Hi Ron,

Your modified original Macro works well. And has solved another prob.

Thanks alot,

Aaron.

Ron Rosenfeld wrote:
On 10 Sep 2006 19:30:16 -0700, "Slashman" wrote:

Hi Ron

I didn't post the macro because I thought it might confuse more.

///////////////////////////////////////////////////////////////////////////////////////////////////////////

Dim KeyCell As Range, AnswerCell As Range
Dim DP As Long
Dim kcFmt As String
Dim acFmt As String

Set KeyCell = [q16]
Set AnswerCell = [x4]

'Get DP from Key Cell
kcFmt = KeyCell.NumberFormat

DP = Len(kcFmt) - InStr(1, kcFmt, ".") + 0 'add a number here to apply
more DP

'Add one decimal place to the KeyCell number format
acFmt = "0." & Application.WorksheetFunction.Rept("0", DP)

'special case of kcFmt is "0"
If kcFmt = "0" Then acFmt = "0.0"

acFmt = "+" & acFmt & ";-" & acFmt & ";0"

'Assign new format to answer cell
AnswerCell.NumberFormat = acFmt

//////////////////////////////////////////////////////////////////////////////////////////////////

I have tried going into format and then custom and adding the \g after
the code and it works nicely.

EG: +0.000\g;-0.000\g;0\g

But the other thing I forgot to mention, is that I sometimes have kg
and N, not always g, how can I automate for this? There is a cell, q17
that will have the sheets g or kg or N in it though if this helps.

Thanks,

Aaron.


That is the macro I gave you :-)


acFmt = "+" & acFmt & [q17] & ";-" & acFmt & [q17] & ";0" & [q17]

You left out the "\". However, that "\" will only work for single characters
and, unlike your initial post, you now write that you may have two characters
to add on. So that needs to be entered within double quote marks.

I think the simplest way to do that, since you have the desired suffix in
[q17], would be as below.

Change the references to KeyCell, AnswerCell and SuffixCell as required. And,
depending on how you set things up, you may have to add a line to reference the
proper worksheet. As written, the macro will run on the Active Worksheet.


==========================================
Option Explicit

Sub IncrDP()

Dim KeyCell As Range, AnswerCell As Range
Dim SuffixCell As Range
Dim DP As Long
Dim kcFmt As String
Dim acFmt As String
Dim Suffix As String

Set KeyCell = [a1]
Set AnswerCell = [a2]
Set SuffixCell = [a3]

'Note the quotes within the quotes.
Suffix = """" & SuffixCell.Text & """"

'Get DP from Key Cell
kcFmt = KeyCell.NumberFormat

DP = Len(kcFmt) - InStr(1, kcFmt, ".") + 1

'Add one decimal place to the KeyCell number format
acFmt = "0." & Application.WorksheetFunction.Rept("0", DP) & Suffix

'special case of kcFmt is "0"
If kcFmt = "0" Then acFmt = "0.0" & Suffix

acFmt = "+" & acFmt & ";-" & acFmt & ";0"

'Assign new format to answer cell
AnswerCell.NumberFormat = acFmt

End Sub
==================================
--ron