Simple Calculation

[Rakesh]

Hi Rocks,

I need you help !!!

I had a Word File and an Excel File. I have to calculate the Character Width of the Data. Character size is defined in the Excel File. I have explained the steps briefly in the attached PDF.

Can we do it in a macro?

Thanks in Advance
Rakesh

[macropod]

So why not do it entirely in Excel?

BTW, the widths you're using are quite possibly rounded off too much (0.5pt increments) and too inconsistently (22 characters are rounded down instead of being rounded to the nearest 0.5pt) to be useful.

[Rakesh]

Hi macropod,

I can’t do it in excel, Because the data I have receiving is in Word Source. The application which I am using, only support word or Txt Files to Import.

We Can’t round off the Character Width. According to the font Family (Arial, Helvetica etc.,) the width may vary and it will be in 0.5 increment.

Thanks,
Rakesh

[macropod]

I can’t do it in excel, Because the data I have receiving is in Word Source. The application which I am using, only support word or Txt Files to Import.
So why not work with the txt files? Excel can both import and export them.

We Can’t round off the Character Width. According to the font Family (Arial, Helvetica etc.,) the width may vary and it will be in 0.5 increment.
I don't know what gives you the idea that any font family has characters whose widths are expressed in 0.5pt increments. That simply is not true. And, even if it was true, your sizes for 22 of the characters are wrong. In any event, despite what you say, you are rounding off the character widths (incorrectly) - to one decimal point. If you think you're not rounding off, what do you suppose the widths would be if you used a font size that is 12.5pt or 11.5pt instead of 12pt?

FWIW, I have a macro that can calculate any font's character widths to at least 4 decimal places and I can assure you that very few of the characters round off at 0.5pt increments for any font at any size.

[Rakesh]

I am using quark application. I have measured the size manually and round off it with .5 increment and defined it in Excel.

Text<*t(234,”)”,”1 “285,”)”,”1 “336,”)”,”1 “)>Paragraph ONE TWO THREE (a)
Text<*t(234,”)”,”1 “285,”)”,”1 “336,”)”,”1 “)>Paragraph (0.18) (0.41) (0.31)

This is a table data. The values 234, 285, 336 are the three column tab positions of the table. The text upto “>” are the tags. While I import this text into my application it will get the text as follows:
Paragraph ONE TWO THREE (a)
Paragraph (0.18) (0.41) (0.31)

To Distribute even space between the column it will take 15 to 30 minutes for one table. I am trying to automate this in the way of changing the tab positions.
If we round off the .5 to 1 for Four characters it may cause 2 points variance between the space.

It can be possible or not?

Thanks,
Rakesh

[macropod]

So why do you want to calculate the width of column 1? Your attachment indicates that it's width is not used for anything.

Also, your document and pdf contain the comment "Columns Count and Row Count may vary". The row count is easily enough handled, but there is nothing in what you've provided to indicate how the column count affects anything. All you've given is an example with 3 columns.

[Rakesh]

Hi macropod,

Your are right!! 1st Column Calculation do nothing.


"Columns Count and Row Count may vary"
I will receive the data, maximum upto 20 columns. As the Column count increases the count of the tab position in the tagged text also increase. So it may be a huge task to me, to distribute even space for 20 Columns.

Attached file the sample of 6 column data for your reference.

Thanks,
John

[macropod]

OK, so what is the logic for happens to the string:
Text<*t(230,”)”,”1 “250,”)”,”1 “270,”)”,”1 “290,”)”,”1 “310,”)”,”1 “330,”)”,”1 “)>

[Rakesh]

Hi macropod,

The Logic is User input becomes as the space in between all columns

As I already explained in the PDF
First I will go to the last column Tab value
Minus the maximum Characters width plus user input with the Last Column Tab value, and
Replace the output with the right most tab value

Doing the same process up to the First column Tab value

Text<*t(234,”)”,”1 “285,”)”,”1 “336,”)”,”1 “)>
= 336 – 54 (3rd column maximum width)
= 282 – 10 (This minus amount wants to be an user input)
= 272 This should be replaced with (285) right most Tab Value (Green colored text)

Text<*t(234,”)”,”1 “272,”)”,”1 “336,”)”,”1 “)>
= 272 – 29 (2nd column maximum width) (This line is typo in PDF)
= 243 – 10 (User Input)
= 233 This should be replaced with (234) right most Tab Value (Red colored text)

Finally Ouput as below:
Text<*t(233,”)”,”1 “272,”)”,”1 “336,”)”,”1 “)>

Red Color indicates 1st Column Tab Value
Green Color indicates 2nd Column Tab Value
Blue Color indicates 3rd Column Tab Value

Thanks,
Rakesh

[macropod]

I could already see that in the 3-column example. What you haven't said is how that process extends to as many as 20 columns.

Assuming the intention is to simply keep doing the same thing, try:
Sub Demo()
Dim i As Long, j As Long, k As Long, t As Single, SngFnt As Single, ArrWdth() As Single
Dim ArrChr As String, StrTmp As String, StrTxt As String, StrFnd As String, StrRep As String
'String Array. As coded, holds character widths for 10pt Arial.
ArrChr = " 2.50 ! 3.35 " & Chr(34) & "4.10 # 5.00 $ 5.00 % 8.25 & 7.75 ' 1.75 ( 3.35 ) 3.35 " & _
"* 5.00 + 5.60 , 2.55 - 3.35 . 2.55 / 2.80 0 5.00 1 5.00 2 5.00 3 5.00 4 5.00 5 5.00 " & _
"6 5.00 7 5.00 8 5.00 9 5.00 : 2.80 ; 2.80 < 5.60 = 5.60 > 5.60 ? 4.45 @ 9.15 A 7.20 " & _
"B 6.65 C 6.65 D 7.20 E 6.10 F 5.55 G 7.20 H 7.20 I 3.35 J 3.90 K 7.20 L 6.10 M 8.85 " & _
"N 7.20 O 7.20 P 5.55 Q 7.20 R 6.65 S 5.55 T 6.10 U 7.20 V 7.20 W 9.45 X 7.20 Y 7.20 " & _
"Z 6.10 [ 3.35 \ 2.75 ] 3.35 ^ 4.70 _ 5.00 ` 3.35 a 4.45 b 5.00 c 4.45 d 5.00 e 4.45 " & _
"f 3.35 g 5.00 h 5.00 i 2.80 j 2.80 k 5.00 l 2.80 m 7.75 n 5.00 o 5.00 p 5.00 q 5.00 " & _
"r 3.35 s 3.90 t 2.80 u 5.00 v 5.00 w 7.20 x 5.00 y 5.00 z 4.45 { 4.80 | 1.95 } 4.80 ~ 5.45 "
'Input the font size & divide by 10 for scaling the output
SngFnt = 12 / 10
'Initialize the output String-width array
ReDim Preserve ArrWdth(1)
'Initialize the Find String
StrFnd = "(^13*)"
With ActiveDocument.Range
' Loop through all paragraphs
For i = 1 To .Paragraphs.Count
'Get the paragraph text, minus the paragraph marker
StrTmp = .Paragraphs(i).Range.Text
StrTmp = Left(StrTmp, Len(StrTmp) - 1)
'Redim the output String-width array, as necessary
If UBound(Split(StrTmp, vbTab)) > UBound(ArrWdth) Then
ReDim Preserve ArrWdth(UBound(Split(StrTmp, vbTab)))
End If
'Process each tab-separated block, ignoring the first one
For j = 1 To UBound(Split(StrTmp, vbTab))
StrTxt = Split(StrTmp, vbTab)(j)
'If there's a decimal number, trim to the last digit
If InStr(StrTxt, ".") > 0 Then
While Not IsNumeric(Right(StrTxt, 1))
StrTxt = Left(StrTxt, Len(StrTxt) - 1)
Wend
End If
'Calculate the string width, based on a 10pt font
t = 0
For k = 1 To Len(StrTxt)
t = t + Split(Split(ArrChr, " " & Mid(StrTxt, k, 1) & " ")(1), " ")(0)
Next
'Re-scale the calculation for the required point size
t = t * SngFnt
'Update the output String-width array
If t > ArrWdth(j) Then ArrWdth(j) = t
Next
Next
'Parse the string to be updated
StrTmp = Split(.Paragraphs.First.Range.Text, vbTab)(0)
'Split at ',”)'
j = UBound(Split(StrTmp, Chr(44) & Chr(148) & ")")) - 1
For i = 0 To j
StrTxt = Split(StrTmp, Chr(44) & Chr(148) & ")")(i)
If i = 0 Then
'For the first item, re-split at '('
StrTxt = Right(StrTxt, Len(StrTxt) - InStrRev(StrTxt, "("))
Else
'For the remaining items, re-split at '“'
StrTxt = Right(StrTxt, Len(StrTxt) - InStrRev(StrTxt, Chr(147)))
End If
'Update the Find expression
StrFnd = StrFnd & StrTxt & "(*)"
Next
'Finalize the Find string
StrFnd = Left(StrFnd, Len(StrFnd) - 3) & "([!^13]{1,})"
'Add the 'master' width to the output String-width array
ReDim Preserve ArrWdth(j + 2)
ArrWdth(j + 2) = StrTxt
'Re-calculate the output String-width array elements
For i = UBound(ArrWdth) - 1 To 0 Step -1
ArrWdth(i) = ArrWdth(i + 1) - ArrWdth(i) - 10
Next
'Generate the Replace string
For i = 1 To UBound(ArrWdth) - 1
StrRep = StrRep & "\" & i & Round(ArrWdth(i + 1), 0)
Next
'Finalize the Replace string
StrRep = StrRep & "\" & i
'Add a temporary paragraph at the start of the document
.InsertBefore vbCr
'Update the document
With .Find
.ClearFormatting
.Replacement.ClearFormatting
.Forward = True
.Wrap = wdFindContinue
.Format = False
.MatchWildcards = True
.Text = StrFnd
.Replacement.Text = StrRep
.Execute Replace:=wdReplaceAll
End With
'Delete the temporary paragraph at the start of the document
.Characters.First = vbNullString
End With
End Sub
Note: The macro doesn't refer to an external file (the real character widths for 10pt text are embedded in the code) and the code can be used for different point sizes simply by changing the 'SngFnt' variable (currently configured for 12pt). The result is far more accurate than what you were using and can be made more accurate still (up to 15 decimal places! instead of whole points).

As you can see, your 'Simple Calculation' is anything but simple.

[Rakesh]

HI macropod,

I tried the macro and it shows the following error:

Run-time error '5560':

The Find What text contains a Pattern Match expression which is not valid

ArrChr = " 2.50 ! 3.35 " & Chr(34) & "4.10 # 5.00 $ 5.00 % 8.25 & 7.75 ' 1.75 ( 3.35 ) 3.35 " & _
"* 5.00 + 5.60 , 2.55 - 3.35 . 2.55 / 2.80 0 5.00 1 5.00 2 5.00 3 5.00 4 5.00 5 5.00 " & _
"6 5.00 7 5.00 8 5.00 9 5.00 : 2.80 ; 2.80 < 5.60 = 5.60 > 5.60 ? 4.45 @ 9.15 A 7.20 " & _
"B 6.65 C 6.65 D 7.20 E 6.10 F 5.55 G 7.20 H 7.20 I 3.35 J 3.90 K 7.20 L 6.10 M 8.85 " & _
"N 7.20 O 7.20 P 5.55 Q 7.20 R 6.65 S 5.55 T 6.10 U 7.20 V 7.20 W 9.45 X 7.20 Y 7.20 " & _
"Z 6.10 [ 3.35 \ 2.75 ] 3.35 ^ 4.70 _ 5.00 ` 3.35 a 4.45 b 5.00 c 4.45 d 5.00 e 4.45 " & _
"f 3.35 g 5.00 h 5.00 i 2.80 j 2.80 k 5.00 l 2.80 m 7.75 n 5.00 o 5.00 p 5.00 q 5.00 " & _
"r 3.35 s 3.90 t 2.80 u 5.00 v 5.00 w 7.20 x 5.00 y 5.00 z 4.45 { 4.80 | 1.95 } 4.80 ~ 5.45 "
How can you get these Character width?

[macropod]

The Find error is due to the expression assuming english-language regional seetings, whereas you appear to be using something else. You can fix that by a single character replacement (ie ',' to ';'), from:
StrFnd = Left(StrFnd, Len(StrFnd) - 3) & "([!^13]{1,})"
to:
StrFnd = Left(StrFnd, Len(StrFnd) - 3) & "([!^13]{1;})"

As for the character widths in the array, see my last comment in post #4.

[Rakesh]

Hi macropod,

Now it's showing the following error in the Highlighted line
Run time error "5"
Invalid procedure call or argument


If InStr(StrTxt, ".") > 0 Then
While Not IsNumeric(Right(StrTxt, 1))
StrTxt = Left(StrTxt, Len(StrTxt) - 1)
Wend
End If


Thanks,
Rakesh

[macropod]

Make the same change there, too. I suspect you'll find a few more lines needing the same change.

[Rakesh]

Make the same change there, too.
what changes should be done and where?

[macropod]

As I said in post #12:

You can fix that by a single character replacement (ie ',' to ';')

[Rakesh]

Hi macropod,

No Where I have found “,” in the script except separator

Thanks,
Rakesh

[macropod]

No Where I have found “,” in the script except separator
So did you replace them?

[Rakesh]

Not able to replace the "," as ";" - any where in the script.

It shows

Compile error:

Expected: list separator or )

[macropod]

Hi Rakesh,

I was only surmizing that you system might need different list separators, just as you needed a different separator for the Find expression (I don't usually work with non-English systems, so I'm not fully conversant with the requirements). That said, using the original code I don't get any errors with the examples you've posted. The only thing I can think of that might be causing an error is that you have a non-numeric string with a period (.) in it. But, since your examples only ever included periods within numeric strings, I didn't code for anything different. So, what kind of data is the code failing with? Please post a sample.

You could also try changing:
If InStr(StrTxt, ".") > 0 Then
to:
If StrTxt Like "*.[0-9]*" Then

[Rakesh]

Hi macropod,

I am also using English System. The System which I am using is "Mac OS X - version 10.6.8", Microsoft Office 2011 for Mac
Whether the coding is not supporting for Mac System?

Herewith I have attached the Sample Data for your reference


Thanks,
Rakesh

[macropod]

Hi Rakesh,

Although you say you're using "the English system", the fact you had to change the Find/Replace code suggests you are not using the standard English-language regional settings.

Your latest sample data file has some significantly different content to what you posted before. Not only do you now have lines with no tabs in them, other lines contain only one tab and non-numeric data with periods. Quite obviously, you can't expect the code to work with data that are so different you what you provided for development. Even so, with the minor code change indicated in post #20, plus the code change indicated below, it should work fine.

Change:
'Parse the string to be updated
StrTmp = Split(.Paragraphs.First.Range.Text, vbTab)(0)
to:

For i = 1 To .Paragraphs.Count
If UBound(Split(.Paragraphs(i).Range.Text, vbTab)) = UBound(ArrWdth) Then
'Parse the string to be updated
StrTmp = Split(.Paragraphs(i).Range.Text, vbTab)(0)
Exit For
End If
Next

[Rakesh]

Hi macropod,

After doing all the changes as per your Instruction, Still now I am facing the following error in the line.

ArrWdth(j + 2) = StrTxt
Run-time error ‘13’:
Type mismatch

As per your post 12 and 22. I have checked my Microsoft Word Language Settings, It was in English and I googled for the Language & Region Settings for MacIntosh System. My language format was in English.

In System preference > Language and Region > Format
I have found 4 type of English Language as follows:

1. English
2. U.S. English
3. Canadian English
4. Australian English

Little bit I was confused. So I tried to test the macro in PC System “Windows 7” which is available in my Office. I checked for the Region and Language Settings.

In Start Window > Control Panel > Region and Language > Format – My Language settings was in English (United States). But the same error occurs in PC also.
I checked for the list of Languages.

I have found 16 types of English Language as follows:

English (Australia)
English (Belize)
English (Canada)
English (Caribbean)
English (India)
English (Ireland)
English (Jamaica)
English (Malaysia)
English (New Zealand)
English (Republic of Philippines)
English (Singapore)
English (South Africa)
English (Trinidad and Tobago)
English (United Kingdom)
English (United States)
English (Zimbabwe)

This drives me mad. :banghead:
Among the above list which one should be the Standard English Language.
Any technical support will be appreciated. :help

Thanks,
Rakesh

[macropod]

I get no errors when running the modified code on the sample data you have supplied.

As for the settings, it appears that, despite nominally being 'English', your list separator setting is non-standard.