DeleteUnusedCustomNumberFormats macro won't work on a workbook

[Bartt Shelton]

I'm trying to use a macro I downloaded from the EEE archives on John
Walkenbach's site.

http://www.j-walk.com/ss/excel/eee/eee007.txt

The macro was written by Leo Heuser & it deletes unused custom cell formats.
The macro is about 1/2 way down the URL listed above.

It has worked like a champ on several of my workbooks, but I've encountered
one where it fails.

It seems to be exiting the first Do loop & heading straight for "Finito"
after the 13th interation (cell format selected is "0%")

Anyone have any idea why?

Running it in XL 97 SR2 on WinNT 4.0 SP5

[David McRitchie]

Hi Bartt,
Leo reposted his code, don't know if there were changes or not,
but you might check try what he recently posted Dec 14, 2000.

I posted this in the misc group today, along with the finding
that Google has expanded the archives back to Mar 29, 1995.
I don't know what Deja had before they started barfing up, but
this is a big improvement as far as working with Excel is concerned.
Still don't have Deja's assignment numbers and don't expect them
to come back, but then Google isn't supplying the message-id
for short references either.

Message 10 in thread
From: Leo Heuser (leo.h...@get2net.dk)
Subject: Re: Too many different cell formats
Newsgroups: microsoft.public.excel.misc
Date: 2000-12-14 00:28:32 PST

FInd it with:

http://groups.google.com/advanced_group_search
newsgroups: microsoft.public.excel.*
author: Leo Heuser
Date: 2000-12-12 to 2000-12-15

HTH,
David McRitchie, Microsoft MVP - Excel (site changed 2000-04-15)
My Excel Macros: http://www.geocities.com/davemcritchie/excel/excel.htm
Search Page: http://www.geocities.com/davemcritchie/excel/search.htm
Google newsgroup search now covers Mar 29, 1995 to current

"Bartt Shelton" <NOSPAMshe...@iname.com> wrote in message
news:OSjP9J2zAHA.1456@tkmsftngp02...

[Bartt Shelton]

David,

Thanks.

Compared Leo's posting to the EEE archive & they appear identical to me.

Any ideas on why it's jumping ship on me?

"David McRitchie" <DMcRi...@msn.com> wrote in message
news:eP42Ox3zAHA.592@tkmsftngp02...

> Hi Bartt,
> Leo reposted his code, don't know if there were changes or not,
> but you might check try what he recently posted Dec 14, 2000.
>
> I posted this in the misc group today, along with the finding
> that Google has expanded the archives back to Mar 29, 1995.

...

[Leo Heuser]

Hi Bartt

The codes are identical. I haven't made any alterations to
the code, since it was published in EEE.
Another user mailed me about the same problem,
and as far as I recall, he also had WinNT.
Unfortunately I can't tell you, what is going on.
What happens, if you delete the format "0%"
manually and then run the macro again?
If your workbook does not contain sensitive material,
you are welcome to zip and attach a copy to a personal
mail (not to the group), provided the file isn't in the megabyte
class :-) (I pay my ISP by the minute)

Best regards
LeoH

"Bartt Shelton" <NOSPAMshe...@iname.com> skrev i en meddelelse
news:egnf8B5zAHA.1488@tkmsftngp03...

[Bartt Shelton]

Thanks.

Unfortunately, the 0% format appears to be one of XL's core formats & can't
be deleted.

The file is fairly large, & does contain some sensitive information.

[Leo Heuser]

I didn't actually "read" your example, and of course you're right about the
0% format.
Here's something to try:

REM-out (set a single apostrophe in front of) the line
'On Error GoTo Finito
Which error message is displayed, when you now run the macro?

Delete the single apostrophe and
insert the line
On Error Resume Next
just above the Do -line
and the line
On Error GoTo Finito
just below the Loop -line
What was the result?

"Bartt Shelton" <NOSPAMshe...@iname.com> skrev i en meddelelse

news:#ROhehA0AHA.1844@tkmsftngp05...

[Bartt Shelton]

Question 1:

Which error message is displayed, when you now run the macro?

Run-time error '1004':

Too many different cell formats.

Question 2:
What was the result?
I get the column headers for the report in cells A1 thru C1. Execution
before making changes did not give those headers.

Cell selection in both cases is CustomFormats!A2.

Not sure I changed the VBA as you wanted for Case 2, but here's what I ran:
.
.
.
On Error GoTo Finito
Worksheets.Add.Move after:=Worksheets(Worksheets.Count)
Worksheets(Worksheets.Count).Name = "CustomFormats"
Worksheets("CustomFormats").Activate
Set Buffer = Range("A2")
Buffer.Select
nFormat(0) = Buffer.NumberFormatLocal
Counter = 1
On Error Resume Next
Do
SaveFormat = Buffer.NumberFormatLocal
Dummy = Buffer.NumberFormatLocal
DoEvents
SendKeys "{tab 3}{down}{enter}"
Application.Dialogs(xlDialogFormatNumber).Show Dummy
nFormat(Counter) = Buffer.NumberFormatLocal
Counter = Counter + 1
Loop Until nFormat(Counter - 1) = SaveFormat
On Error GoTo Finito

ReDim Preserve nFormat(0 To Counter - 2)
.
.
.

[Leo Heuser]

Bartt,

You changed it all right in question 2.
Maybe the problem is a question of lack of memory.
Here are some suggestions, you might try:

1. Make Excel the only open application, when you run the macro.

2. Try running it on a computer with larger RAM capacity.

3. In question 2 insert the line
MsgBox Counter
below the Loop-line and run the macro
Insert the returned number instead of 1000 in the line
NumberOfFormats = 1000
REM-out the MsgBox line and run the macro again.

4. Manually delete some of the superfluous number formats
and try running the macro again.

It would have been nice to test the workbook, but since this is not
possible,
I'm afraid the above mentioned points are all I can offer for now :-(

Best regards
LeoH

"Bartt Shelton" <NOSPAMshe...@iname.com> skrev i en meddelelse

news:Orrp3jZ0AHA.1844@tkmsftngp05...

[Bartt Shelton]

Leo,

Suggest we move off-line until we come up w/ a solution or reach a dead-end.

I'll send you an email.

Thanks,
Bartt

[Desart Eric]

Bartt, Leo

I should appreciate if you continue here, since I'm very interested in
the problem too.

Many thanks, and kind regards

Eric

"Bartt Shelton" <NOSPAMshe...@iname.com> schreef in bericht
news:ulKlZ3k0AHA.2236@tkmsftngp02...

[Bartt Shelton]

If Leo doesn't post back w/ an update, I will once I hear back from him. I
ended up emailing the file to him & he's going to see what he can do with
it. He said it will probably take him a few days.

I simply thought most users would get annoyed following a very slow
investigation trail. We've already got 8 nested threads into this thing &
haven't made any substantial progress yet. We'll let you know what Leo
finds.

Thx,
Bartt

[Leo Heuser]

Hi Bartt and Eric,

I have made an update, which should solve the problem.
Instead of placing the data in the present workbook in the
sheet "CustomFormats", the update places it in a new
workbook, which you can delete, when the job is done.

Please let me know how it turns out.

Best regards
LeoH

Update:

Sub DeleteUnusedCustomNumberFormats()
'leo.h...@get2net.dk, May 6. 2001
'Version 1.01
Dim Buffer As Object
Dim Sh As Object
Dim SaveFormat As Variant
Dim fFormat As Variant
Dim nFormat() As Variant
Dim xFormat As Long
Dim Counter As Long
Dim Counter1 As Long
Dim Counter2 As Long
Dim StartRow As Long
Dim EndRow As Long
Dim pPresent As Boolean
Dim NumberOfFormats As Long
Dim Answer
Dim Cell As Object
Dim DataStart As Long
Dim DataEnd As Long
Dim AnswerText As String
Dim ActWorkbookName As String
Dim BufferWorkbookName As String

NumberOfFormats = 1000
StartRow = 3 ' Do not alter this value
EndRow = 16384 ' For Excel 97 and 2000 set EndRow to 65536

ReDim nFormat(0 To NumberOfFormats)

AnswerText = "Do you want to delete unused custom formats from the
workbook?"
AnswerText = AnswerText & Chr(10) & "To get a list of used and unused
formats only, choose No."
Answer = MsgBox(AnswerText, 259)
If Answer = vbCancel Then GoTo Finito

On Error GoTo Finito
ActWorkbookName = ActiveWorkbook.Name
Workbooks.Add
BufferWorkbookName = ActiveWorkbook.Name

Set Buffer = Workbooks(BufferWorkbookName).ActiveSheet.Range("A3")
nFormat(0) = Buffer.NumberFormatLocal
Buffer.NumberFormat = "@"
Buffer.Value = nFormat(0)

Workbooks(ActWorkbookName).Activate

Counter = 1
Do
SaveFormat = Buffer.Value
DoEvents
SendKeys "{TAB 3}"
For Counter1 = 1 To Counter
SendKeys "{DOWN}"
Next Counter1
SendKeys "+{TAB}{HOME}'{HOME}+{END}^C{TAB 4}{ENTER}"
Application.Dialogs(xlDialogFormatNumber).Show nFormat(0)
ActiveSheet.Paste Destination:=Buffer
Buffer.Value = Mid(Buffer.Value, 2)
nFormat(Counter) = Buffer.Value

Counter = Counter + 1
Loop Until nFormat(Counter - 1) = SaveFormat

ReDim Preserve nFormat(0 To Counter - 2)

Workbooks(BufferWorkbookName).Activate

Range("A1").Value = "Custom formats"
Range("B1").Value = "Formats used in workbook"
Range("C1").Value = "Formats not used"
Range("A1:C1").Font.Bold = True

For Counter = 0 To UBound(nFormat)
Cells(StartRow, 1).Offset(Counter, 0).NumberFormatLocal =
nFormat(Counter)
Cells(StartRow, 1).Offset(Counter, 0).Value = nFormat(Counter)
Next Counter

Counter = 0
For Each Sh In Workbooks(ActWorkbookName).Worksheets
For Each Cell In Sh.UsedRange.Cells
fFormat = Cell.NumberFormatLocal
If Application.WorksheetFunction.CountIf(Range(Cells(StartRow,
2), Cells(EndRow, 2)), fFormat) = 0 Then
Cells(StartRow, 2).Offset(Counter, 0).NumberFormatLocal =
fFormat
Cells(StartRow, 2).Offset(Counter, 0).Value = fFormat

Counter = Counter + 1

End If
Next Cell
Next Sh

xFormat = Range(Cells(StartRow, 2), Cells(EndRow, 2)).Find("").Row - 2
Counter2 = 0
For Counter = 0 To UBound(nFormat)
pPresent = False
For Counter1 = 1 To xFormat
If nFormat(Counter) = Cells(StartRow, 2).Offset(Counter1,
0).NumberFormatLocal Then
pPresent = True
End If
Next Counter1
If pPresent = False Then
Cells(StartRow, 3).Offset(Counter2, 0).NumberFormatLocal =
nFormat(Counter)
Cells(StartRow, 3).Offset(Counter2, 0).Value = nFormat(Counter)
Counter2 = Counter2 + 1
End If
Next Counter
With ActiveSheet.Columns("A:C")
.AutoFit
.HorizontalAlignment = xlLeft
End With
If Answer = vbYes Then
DataStart = Range(Cells(1, 3), Cells(EndRow, 3)).Find("").Row + 1
DataEnd = Cells(DataStart, 3).Resize(EndRow, 1).Find("").Row - 1
On Error Resume Next
For Each Cell In Range(Cells(DataStart, 3), Cells(DataEnd, 3)).Cells
Workbooks(ActWorkbookName).DeleteNumberFormat
(Cell.NumberFormat)
Next Cell
End If
Finito:
Set Cell = Nothing
Set Sh = Nothing
Set Buffer = Nothing
End Sub

____________________________

"Bartt Shelton" <NOSPAMshe...@iname.com> skrev i en meddelelse

news:OUrFczn0AHA.2108@tkmsftngp03...

[Leo Heuser]

Hi Bartt (and Eric),

Best regards
LeoH

Update:

ReDim nFormat(0 To NumberOfFormats)

Workbooks(ActWorkbookName).Activate

Counter = Counter + 1
Loop Until nFormat(Counter - 1) = SaveFormat

ReDim Preserve nFormat(0 To Counter - 2)

Workbooks(BufferWorkbookName).Activate

Range("A1").Value = "Custom formats"
Range("B1").Value = "Formats used in workbook"
Range("C1").Value = "Formats not used"
Range("A1:C1").Font.Bold = True

For Counter = 0 To UBound(nFormat)
Cells(StartRow, 1).Offset(Counter, 0).NumberFormatLocal =
nFormat(Counter)
Cells(StartRow, 1).Offset(Counter, 0).Value = nFormat(Counter)
Next Counter

Counter = 0
For Each Sh In Workbooks(ActWorkbookName).Worksheets
For Each Cell In Sh.UsedRange.Cells
fFormat = Cell.NumberFormatLocal
If Application.WorksheetFunction.CountIf(Range(Cells(StartRow,
2), Cells(EndRow, 2)), fFormat) = 0 Then
Cells(StartRow, 2).Offset(Counter, 0).NumberFormatLocal =
fFormat
Cells(StartRow, 2).Offset(Counter, 0).Value = fFormat

Counter = Counter + 1

DataEnd = Cells(DataStart, 3).Resize(EndRow, 1).Find("").Row - 1
On Error Resume Next

For Each Cell In Range(Cells(DataStart, 3), Cells(DataEnd, 3)).Cells
Workbooks(ActWorkbookName).DeleteNumberFormat
(Cell.NumberFormat)
Next Cell
End If
Finito:
Set Cell = Nothing
Set Sh = Nothing
Set Buffer = Nothing
End Sub

____________________________

"Bartt Shelton" <NOSPAMshe...@iname.com> skrev i en meddelelse

news:OUrFczn0AHA.2108@tkmsftngp03...

[Desart Eric]

Thanks Leo

I'm going to try it.
Best regards
Eric

"Leo Heuser" <leo.h...@get2net.dk> schreef in bericht
news:Op2qcqh1AHA.2236@tkmsftngp02...

[Desart Eric]

Hi Leo

I copied your procedure in an Excel 5 workbook, which I then saved
I opened another workbook in which I entered a number in a range (ca 100
values).
I first formatted them to 0.0 then 0.00 then 0.000 then 0.0000 then
0.00000.
So in fact, finally I only use the last one, since there are no values
anymore with the previous formatting.
I run your macro.
I check the workbook. All those formats are still there.
In the list (new workbook made by your macro) they are mentioned in your
1st column beneath all standard Excel formats.
In the 2nd and 3rd column nothing is mentioned.
Nothing is deleted.
What am I doing wrong?
I don't know enough VBA to understand the macro.

Can you make the macro itself define if there are 16384 or 65536 rows?
I'm working with both (probably a few lines, but I don't know how?

Kind regards

Eric

"Leo Heuser" <leo.h...@get2net.dk> schreef in bericht
news:Op2qcqh1AHA.2236@tkmsftngp02...

[Leo Heuser]

Hi Eric

I have no experience with Excel 5, but I have no trouble
getting the macro to function in Excel 2000.

The workbook containing the number formats to be deleted
*must* be the *active* workbook, when the macro is
executed.

Does version 1 function for you?

Do red lines exist in the code, when looking at it in the
VBA editor?

Try putting a single apostrophe at the beginning of the line

On Error Goto Finito like this
'On Error Goto Finito

Run the macro again. Which error message pops up and
which line is highlighted in the code?
-----------------------------

In order to define EndRow, you
can insert these lines in the code:

If Application.Version > "7.0" Then
EndRow = 65536
Else
EndRow = 16384
End If

Best regards
LeoH

"Desart Eric" <af...@belgacom.net> skrev i en meddelelse
news:OH3TUav1AHA.1844@tkmsftngp05...

[Desart Eric]

Hi Leo

Many thanks for your response:
Here a summary:

| The workbook containing the number formats to be deleted
| *must* be the *active* workbook, when the macro is
| executed

I tried it that way, was OK

| Does version 1 function for you?

Don't know yet, since I waited until your discussion with Bartt came to
a conclusion, as such have no copy yet of version 1, and messages in
newsgroup disappeared.

| Do red lines exist in the code, when looking at it in the
| VBA editor?

No, I corrected the lines directly that were splitted in the message,
everithing looked OK

| Try putting a single apostrophe at the beginning of the line
| On Error Goto Finito like this
| 'On Error Goto Finito

Did it and got following Error:
Run-time error '438'
Object doesn't support this property or method
Error appeared in this line:

If Application.WorksheetFunction.CountIf(Range(Cells(StartRow, 2),
Cells(EndRow, 2)), fFormat) = 0 Then

In analogy with a previous (other problem related to rounding) problem
Myrna told me that WorksheetFunction only exists from >= Excel 97. So I
changed the line as follows (don't know if this is correct, please
confirm).
If Application.CountIf(Range(Cells(StartRow, 2), Cells(EndRow, 2)),
fFormat) = 0 Then
At least it seems to work now (I get the 3 columns with exact info).

Now I get the next new error:
Run-time error '1004'
Resize method or Range class failed
Seems to originate from this line:

DataEnd = Cells(DataStart, 3).Resize(EndRow, 1).Find("").Row - 1

This is part of (at the end of procedure where you delete the obselate
formats):

If Answer = vbYes Then
DataStart = Range(Cells(1, 3), Cells(EndRow, 3)).Find("").Row +
1
DataEnd = Cells(DataStart, 3).Resize(EndRow, 1).Find("").Row - 1
On Error Resume Next
For Each Cell In Range(Cells(DataStart, 3), Cells(DataEnd,
3)).Cells
Workbooks(ActWorkbookName).DeleteNumberFormat
(Cell.NumberFormat)
Next Cell
End If

Row: Expression not defined in context (found via Watch), the other
variables seemed Ok, as far as I could judge (beginning VBAer)
Looked in the Help but did not understand what to do with it:
object
Required. The Range object.

| In order to define EndRow, you
| can insert these lines in the code:
|
| If Application.Version > "7.0" Then
| EndRow = 65536
| Else
| EndRow = 16384
| End If

Thanks for this.

Leo I think it is only this last error 1004 in order to solve the
procedure to make it compatible for all Excel versions (I hope). Can
you please have another look at it. Is my solution for the error 438
OK?
With many thanks

Eric

"Leo Heuser" <leo.h...@get2net.dk> schreef in bericht

news:u8ZlWCy1AHA.1352@tkmsftngp05...

[Desart Eric]

Hi Leo

I also tried now your ORIGINAL version 1.1 code in MS Excel 97 Dutch
version (but the VBA code in this version remains English)
1) The macro turns off num lock, without resetting it.
2) If I enter a list of numbers formatted as "0.00000", and beneath that
a cel with a number formatted as "0.0", and have some obselates 0.000,
0.0000, then it only sets the General ('Standaard' in Dutch) and the
0.00000 in the column used formats. The format 0.0, which is also used
is not mentioned here, but in the column unused.
3) The macro didn't work correctly with deleting (deleted nothing), so I
tried again your suggestion:

| | On Error Goto Finito like this
| | 'On Error Goto Finito

Then it shows the same error 1004 as I mentioned in the previous
message.
Gives me the feeling, that this line is only understood as such in Excel
2000.
Hope this additional info can help.

Kind regards.

Eric

"Desart Eric" <af...@belgacom.net> schreef in bericht
news:eG0GgP01AHA.1792@tkmsftngp02...

[Desart Eric]

Hi Leo

Tried to send this earlier but couldn't get contact with the server (so
could not dend message).

I also tried now your ORIGINAL version 1.1 code in MS Excel 97 Dutch
version (but the VBA code in this version remains English)
1) The macro turns off num lock, without resetting it.
2) If I enter a list of numbers formatted as "0.00000", and beneath that
a cel with a number formatted as "0.0", and have some obselates 0.000,
0.0000, then it only sets the General ('Standaard' in Dutch) and the
0.00000 in the column used formats. The format 0.0, which is also used
is not mentioned here, but in the column unused.
3) The macro didn't work correctly with deleting (deleted nothing), so I
tried again your suggestion:

| | On Error Goto Finito like this
| | 'On Error Goto Finito

Then it shows the same error 1004 as I mentioned in the previous
message.
Gives me the feeling, that this line is only understood as such in Excel
2000.
Hope this additional info can help.

Kind regards.

Eric

"Desart Eric" <af...@belgacom.net> schreef in bericht
news:eG0GgP01AHA.1792@tkmsftngp02...

[Leo Heuser]

Hi Eric,

You're welcome!
Let's see, if we can get to the bottom of this :-)

> | Try putting a single apostrophe at the beginning of the line
> | On Error Goto Finito like this
> | 'On Error Goto Finito
> Did it and got following Error:
> Run-time error '438'
> Object doesn't support this property or method
> Error appeared in this line:
> If Application.WorksheetFunction.CountIf(Range(Cells(StartRow, 2),
> Cells(EndRow, 2)), fFormat) = 0 Then
>
> In analogy with a previous (other problem related to rounding) problem
> Myrna told me that WorksheetFunction only exists from >= Excel 97. So I
> changed the line as follows (don't know if this is correct, please
> confirm).
> If Application.CountIf(Range(Cells(StartRow, 2), Cells(EndRow, 2)),
> fFormat) = 0 Then
> At least it seems to work now (I get the 3 columns with exact info).

You're quite right.

>
> Now I get the next new error:
> Run-time error '1004'
> Resize method or Range class failed
> Seems to originate from this line:
> DataEnd = Cells(DataStart, 3).Resize(EndRow, 1).Find("").Row - 1

Try replacing the original lines by these:

If Answer = vbYes Then

DataStart = StartRow
DataEnd = DataStart + Counter2 - 1

On Error Resume Next
For Each Cell In Range(Cells(DataStart, 3), Cells(DataEnd, 3)).Cells

Workbooks(ActWorkbookName).DeleteNumberFormat Cell.NumberFormat
Next Cell
End If

> | In order to define EndRow, you
> | can insert these lines in the code:
> |
> | If Application.Version > "7.0" Then
> | EndRow = 65536
> | Else
> | EndRow = 16384
> | End If
> Thanks for this.
>

To make sure, that it will also work, when version 10 is released use
this syntax instead:

If Clng(Application.Version) > Clng("7.0") Then

EndRow = 65536
Else
EndRow = 16384
End If

This is necessary since the string "10.0" is smaller than the string "7.0".

Best regards
LeoH

[Bartt Shelton]

Leo,

SUCCESS! Many, Many thanks.

Your revised If vbYes routine did the trick for deleting the formats.

Eric,

I ran into a similar '1004' Run-Time error when executed from 97 SR2. Mine
was "Application-defined or object-defined error." You indicated yours was
"Resize method or Range class failed." Don't know why there would be a
difference.

A couple of notes:

1) Leo, as I indicated in my emails, I'd like to leave this routine in my
Personal.xls file. I was able to run 1.01 (after latest changes)
successfully on the active workbook. You had told me earlier to put the
routine in the target workbook & make sure I ran it from "This Workbook."
Are there conditions that would cause it to fail if run on the active
workbook from Personal?

2) I got a type-mismatch error on your version check statements & had to
change it:

If Val(Application.Version) > Val("7.0") Then

I'd think this should work as long as MicroSoft doesn't include any alpha
characters in the Version. Have they ever done that in the past?

[Desart Eric]

Hello Leo

Sorry for my late reaction, but this testing is night work for me.
Thanks for trying to solve this.

A few points:

| If Clng(Application.Version) > Clng("7.0") Then
| EndRow = 65536
| Else
| EndRow = 16384
| End If

This only works when Application.Version is a number.
My version is 8.0e, so it didn't work.
Another version I have = 5.0c
I also have a version 8.0 e (notice the blank between 0 and e).
I work with a lot of Excel versions in different languages. My
experience is that one can't trust this version to rely on. It can be
written in different ways.
I've no idea of the effect on the 'If Application.Version > "7.0" Then'
approach

I wonder if you can't define the number of rows in a different, safer
way independent of how Microsoft writes the version number.
Something as:
a) screen updating off
b) key combination Control + Arrow down (of any other alternative)
c) Row number?
d) key combination Control + Arrow Up (of any other alternative)
a) screen updating on
This is just an idea, there are maybe better ways. In Excel4 language,
there are function doing that without sending keys, so probably also in
VBA. Or you can countblank(A:A) or VBA alternative when opening the new
file, or................

It still does an error in defining which values are used and which are
not (tried it as well in 97 SR2 Dutch as in Excel 5 English. Both
reacted the same.
The delete procedure follows the list as far as I can judge, but the
list is wrong.
I can't find the reason, but this is caused by the fact that I'm not
familiar with VBA code.

Try this example:
Range D9:M23 enter 50. Then with the decimals tools to 50.0, 50.00,
50.000, 50.0000, 50.00000
Cell H26 enter 50 Then with the decimals tools to 50.0
Obsolete are now : 50.000, 50.0000 (50.00 is a standard format)
Run Macro:
Notice: 50.0 is in the not used column and will be deleted.

Now set 50.0 above the large range. Do the same.
Notice: 50.00000 appears in the not used column and will be deleted.

Can you figure it out?
Kind regards and thanks, Eric

To Bart
................Don't know why there would be a difference.
I don't know it either, I literally wrote what I saw on the screen.

................I'd think this should work as long as Microsoft doesn't

include any alpha characters in the Version. Have they ever done that
in the past?

I've seen this already in different combinations, with and without
blanks and an additional character, numbers alone etc. In my program I
don't dear to rely on that, or you must filter the text, in order only
to find the number characters (I filter anything not being a number and
a point, until I can convert it into a value).

Kind regards
Eric.

"Leo Heuser" <leo.h...@get2net.dk> schreef in bericht

news:#JctnLG2AHA.720@tkmsftngp03...

[Leo Heuser]

You're welcome!
See comments below. (also to Eric)

"Bartt Shelton" <NOSPAMshe...@iname.com> skrev i en meddelelse

news:eli5#BJ2AHA.1440@tkmsftngp03...

> Leo,
>
> SUCCESS! Many, Many thanks.
>
> Your revised If vbYes routine did the trick for deleting the formats.
>

> A couple of notes:
>
> 1) Leo, as I indicated in my emails, I'd like to leave this routine in my
> Personal.xls file. I was able to run 1.01 (after latest changes)
> successfully on the active workbook. You had told me earlier to put the
> routine in the target workbook & make sure I ran it from "This Workbook."
> Are there conditions that would cause it to fail if run on the active
> workbook from Personal?
>

Apparently I haven't been clear about this. What I meant was, that wherever
the routine resides, if you run it, it will perform its work on the *active*
workbook,
so putting it in Personal.xls is just common sense :-)

> 2) I got a type-mismatch error on your version check statements & had to
> change it:
>
> If Val(Application.Version) > Val("7.0") Then
>
> I'd think this should work as long as MicroSoft doesn't include any alpha
> characters in the Version. Have they ever done that in the past?
>

Unfortunately yes. Eric has a few words about this in his latest posting to
this thread.

To Eric:
To get the number of the endrow, you can use

EndRow = Rows.Count

but I don't know, if this syntax is supported in Excel 5.0
I'll return later with comment on your example.

Best regards
LeoH

[Desart Eric]

Hi Leo
I tried to find things myself but my VBA background is to limited, I'm
more gambling than understanding.

| EndRow = Rows.Count
This does not work in MS Excel 5

Result:
run-time error 1004
Rows method of Application class failed
I tried several things, but this is just gambling since I don't
understand what I'm doing myself, so gave it finally up.

What I can see is that Excel 5 knows the worksheet functions column,
columns, row, rows, countblank etc. Also VBA Row, Rows, Column and
Column is recognized.

THE FOLLOWING IS JUST COPIED FROM HELP
Syntax 2
object.Rows
Elements
The Rows method has the following object qualifier and named arguments:
object
Optional for Application, required for Range and Worksheet. The object
to which this method applies.
index
Required for Syntax 1. The name or number of the row.
Remarks
When applied to a Range object that is a multiple selection, this method
returns rows from the first area of the range only. For example, if the
Range object is a multiple selection with two areas, A1:B2 and C3:D4,
Selection.Rows.Count, returns 2, not 4. To use this method on a range
that may contain a multiple selection, test Areas.Count to determine if
the range is a multiple selection, and if it is, then loop over each
area in the range; see the second example.
END HELP

Hope this information is of use.

Kind regards
Eric

"Leo Heuser" <leo.h...@get2net.dk> schreef in bericht

news:#7zNGBT2AHA.1228@tkmsftngp02...

[Bartt Shelton]

Leo,

The user informed me of another format issue (Error - Too many different
cell formats.) that was occurring in the same workbook.

Do you know if this is directly related?

User said if she encountered the error & tried to format a cell directly, it
wouldn't take. However, if a format was copy/pasted from another cell w/
desired format, it would work (I've confirmed this.)

I searched Google.com, but didn't see anything there.

I'm going to post it in .misc to see if anyone has encountered it before.

[Desart Eric]

Leo and Bartt

I really should like this utility to work.
I find it very useful.
So I did some more testing.
And I encounter strange things, which I can't explain. And I don't know
enough VBA to understand how the procedure exactly works.

Therefor a summary:

1)

| EndRow = Rows.Count
This does not work in MS Excel 5

2)
In my Dutch Excel 97 version for one or another reason the Num Lock key
gets disabled and not reset. This happens as well when I select Yes or
No in the dialog.

3)
Try a simple Example:
enter 15 in F12
enter 15 in F14
Now with the more decimals tool reformat F12 to 15.00000
Now with the more decimals tool reformat F12 to 15.0
Run the macro:
If NO delete: 15.0 is set in the non-used column
If YES delete: 15.0 is set in the non-used column
Both formats 15.00000 and 15.0 are deleted.

I can't figure it out.

Bartt does it do the same on your Excel version? Please check.

If you can solve it Leo I should be most grateful.

Just an idea, of something I made some years ago in the Macro4 language.
First I want to replace this since I couldn't get the send keys to work
on an Excel dialog. I could to other programs. Maybe I did this wrong,
but anyhow was forced to delete all formats manually.
But in order to avoid manually to check, which were used, or not used
formats:
1) My macro first checked that no sheets were protected, warning the
user to unprotect the document first.
2) My macro first copied the sheets of the workbook into a temporary
file
3) Showed the format number dialog, where the user must delete manually
all custom formats.
4) copied the previously copied temporary sheets again, and pasted the
formats back into the respective original sheets, thereby restoring the
used formats.
5) Deleted the temporary file.
By disabling screen updating where needed, I made this process invisible
for the user.
I should like to replace my macro by something better, since this manual
intervention wasn't good.

I only tell this as a possible idea, if the above mentioned problems are
not easy to solve.
Such a macro is so intrusive, that one must be sure that it does not
delete anything that shouldn't.
This is not meant as criticism but as a cry for help.

With many thanks and kind regards

Eric

"Bartt Shelton" <NOSPAMshe...@iname.com> schreef in bericht

news:uhagl9W2AHA.1756@tkmsftngp07...

[Bartt Shelton]

Eric,

Leo's probably spent more time on this than should be expected of anyone &
probably has much better (i.e. revenue generating) things to do. Although I
don't have any experience in generating VBA, I can usually follow programs
reasonably well. I'll bet there's a glitch w/ the array to which the
formats are being assigned.

Right now, I'm swamped w/ other responsibilities & I don't know when I'll
get a chance to do it, but I'll try to go thru the logic in detail & see if
I can determine what's going on. If I find anything, I'll email you & Leo.
Until then, I don't think I want to ask any more of Leo - already gone above
& beyond any call of duty.

When I run your test case thru the No option, I show two formats in the used
column, "0.0" & "general". I don't get "0.00000", which is also used in
F14.

At the bottom of the unused formats column, I get the "0.0", "0.000",
"0.0000", & "0.00000" formats that I had to add w/ each toolbar button click
on the way from "0.0" to "0.00000". Anyway, "0.0" is showing up in both
lists & "0.00000" is only showing up in the unused list.

Under the Yes delete version, I get the same report & both the "0.0" &
"0.00000" formats are deleted, as are the "0.000" & "0.0000".

"0.00" can't be deleted (at least from the English version) because it
appears to be a core format.

When I run the test cases under v.1.0, I get the same results, except on the
"Yes" delete version. There, the only difference is that the listings for
the custom formats in the report are not displayed as the formats were
entered. They are displayed as "0" - however, this is understandable. The
routine actually formats the cells in the report instead of pasting a text
string that looks like the format. Since the worksheet is in the same
workbook & the format has just been deleted, it can't display it.

I would bet that's why Leo changed the routine to create a new workbook w/
v.1.01.

[Desart Eric]

Bartt and Leo

Bartt thanks for reacting.

Leo I don't want to push neither you nor Bartt.

I do respect your know-how and input for which I'm grateful.
Since I do take it serious, I thought it to be better to give a honest
response in order for Leo to get a picture from a users point of view.
I still hope that Leo, somehow, if not now, then in the future, can
finish it.

With very kind regards

Eric

"Bartt Shelton" <NOSPAMshe...@iname.com> schreef in bericht

news:OBzAJEk2AHA.964@tkmsftngp03...

[Desart Eric]

Small part is solved:
Based on one of the answers of Tom Ogilvy:

If Val(Application.Version) < 8 Then
EndRow = 16384
Else
EndRow = 65536
End If
This works: The Val function excludes all characters from 5.0c, 8.0e,
8.0 e and transforms all 3 in a valid number (so Bartt your Val
suggestion solves those problems).

Kind regards
Eric

"Desart Eric" <af...@belgacom.net> schreef in bericht

news:#jYigLl2AHA.968@tkmsftngp07...

[Desart Eric]

Hi Leo Bartt

I found the reason that NumLock is disabled in non-English versions.
This problem is easy to be solved. For me it was important to know the
reason for this phenomenon in order to know if it was causing errors in
the procedure or not. It isn't
What happens is:
SendKeys "{DOWN}"

SendKeys "+{TAB}{HOME}'{HOME}+{END}^C{TAB 4}{ENTER}

Automatically another language version will use the DOWN and ENTER (and
the others which are mentioned in the numeric keypad) as key to be
activated thereby automatically disabling the NumLock key. For ENTER
one can solve this by using a '~', but not for the others.
This can be solved by entering this line in the Finito part of the
procedure:

Finito:
Set Cell = Nothing
Set Sh = Nothing
Set Buffer = Nothing

SendKeys "1{ESC}" 'added line

This forces NumLock to enable again, and it doesn't hurt in the English
version..

Kind regards

Eric

"Desart Eric" <af...@belgacom.net> schreef in bericht

news:#htaGDn2AHA.2296@tkmsftngp02...

[Desart Eric]

Hello Leo & Bartt

Eureka it works. Leo many, many thanks for your code.

As non-VBA'er I was really fighting against the unknown, but this is
typical something impossible in the Macro4 language (you can't send keys
to Excel dialog boxes).
I enter here the resulting code. I left extra sentences to show where I
changed something.
You probably better remove them. Only did it to make the deviations
clear.
If You could clean it up a bit better, I should like to hear it.
It works now from Excel 5 upward, in all languages. I see no remaining
problems.

Again with many thanks.
Eric

'With the Val function below also 8.0e, 8.0 e, 5.0c etc. are transformed
in a number.

If Val(Application.Version) < 8 Then
EndRow = 16384
Else
EndRow = 65536
End If

ReDim nFormat(0 To NumberOfFormats)

Workbooks(ActWorkbookName).Activate

Workbooks(BufferWorkbookName).Activate

Cells(StartRow, 1).Offset(Counter, 0).Value = "F: " &
nFormat(Counter)
' "F: " only added for symetry with second column, but not really
needed

Next Counter

Counter = 0
For Each Sh In Workbooks(ActWorkbookName).Worksheets
For Each Cell In Sh.UsedRange.Cells
fFormat = Cell.NumberFormatLocal

If Application.CountIf(Range(Cells(StartRow, 2),
Cells(EndRow, 2)), "F: " & fFormat) = 0 Then
' Application.worksheetfunction.countif removed to guarantee
backward compatibility
' "F: " added to force being text in order to avoid 0.0,
0.000 etc.. wrongly treated

Cells(StartRow, 2).Offset(Counter, 0).NumberFormatLocal
= fFormat

Cells(StartRow, 2).Offset(Counter, 0).Value = "F: " &

fFormat
Counter = Counter + 1
End If
Next Cell
Next Sh

' xFormat = Range(Cells(StartRow, 2), Cells(EndRow,
2)).Find("").Row - 2

' The above line is changed (corrected to correct offset + 1 too
high)

xFormat = Range(Cells(StartRow, 2), Cells(EndRow, 2)).Find("").Row -

4

Counter2 = 0
For Counter = 0 To UBound(nFormat)
pPresent = False

' For Counter1 = 1 To xFormat This line is changed (offset was
wrong)
For Counter1 = 0 To xFormat

If nFormat(Counter) = Cells(StartRow, 2).Offset(Counter1,
0).NumberFormatLocal Then
pPresent = True
End If
Next Counter1
If pPresent = False Then
Cells(StartRow, 3).Offset(Counter2, 0).NumberFormatLocal =
nFormat(Counter)

Cells(StartRow, 3).Offset(Counter2, 0).Value = "F: " &
nFormat(Counter)
' "F: " only added for symetry with second column, but not
needed

Counter2 = Counter2 + 1
End If
Next Counter
With ActiveSheet.Columns("A:C")
.AutoFit
.HorizontalAlignment = xlLeft
End With

If Answer = vbYes Then

DataStart = StartRow
DataEnd = DataStart + Counter2 - 1
On Error Resume Next
For Each Cell In Range(Cells(DataStart, 3), Cells(DataEnd,
3)).Cells
Workbooks(ActWorkbookName).DeleteNumberFormat
Cell.NumberFormat
Next Cell
End If

Finito:

Set Cell = Nothing
Set Sh = Nothing
Set Buffer = Nothing

SendKeys "1{ESC}" 'corrects wrong NumLock disabling in non-English
versions
End Sub

"Bartt Shelton" <NOSPAMshe...@iname.com> schreef in bericht

news:OBzAJEk2AHA.964@tkmsftngp03...

[Leo Heuser]

Bartt and Eric,

I'm glad to see, that both of you have the routine up and working!
I'll dig into version 1.01 *later* (:-) to see, if it needs some
"edge-cutting".

Bartt

Yes, you're right, but it has been a nice experience!
The main reason for collecting the formats in a new workbook instead of
in a new sheet in the workbook to be cleansed, was that it was not possible
to add more formats to your original workbook (that's why the number-format
dialog only rolled through the first 13 formats). I still believe, there's
an internal
error prowling around somewhere in your workbook, but it may happen to
others too, so I thought, it would be a good idea to use an external sheet
for
the formats collection.

Eric

You're welcome!
Although it can only have historical interest now, I believe that
EndRow = ActiveSheet.Rows.Count
will also work in Excel 5.0.

In my code I use the UsedRange property which, prior to Excel 97, only
got updated (by Excel), if you saved the workbook, after having made
alterations to
a sheet. This may have caused some of the problems you have
encountered in your example from may 10. with the range D9:M23 etc.

Thanks to you both for the thoughts and ideas you have posted!

Best regards
LeoH

"Bartt Shelton" <NOSPAMshe...@iname.com> skrev i en meddelelse

news:OBzAJEk2AHA.964@tkmsftngp03...

[Desart Eric]

Hi Leo

I don't dear to ask it anymore, so I tried myself but can't find the
solution.
The question is with the 'Yes' answer in the dialog box, the procedure
creates a list and deletes all not used number formats.
Can you make a list, say in column 4 (D) of the real deleted number
formats?

Since MS Excel does NOT delete the build in formats, you entered this in
an:

On Error Resume Next
For Each Cell In Range(Cells(DataStart, 3), Cells(DataEnd,
3)).Cells
Workbooks(ActWorkbookName).DeleteNumberFormat
Cell.NumberFormat
Next Cell

However, as far as I can see (tried it also in Excel4 language), it just
not delete Build-In formats, without giving in fact a run time error,
when it can't delete such a format.
It should have been easy if a error handler, could distinguish between
the build-in and the custom formats, but since it doesn't seem to
generate an error (if I'm correct), you can't use this, to generate a
list of real deleted formats.

Another solution should be to recheck the precense of the formats in the
workbook (after deletion), based on the formats you already set in
column 3 of the list. The ones not found are then the ones deleted.
I think this should be based on some (to be repeated but adjusted) code
of yours (higher up in your procedure):

Counter = 0
For Each Sh In Workbooks(ActWorkbookName).Worksheets
For Each Cell In Sh.UsedRange.Cells
fFormat = Cell.NumberFormatLocal

If Application.CountIf(Range(Cells(StartRow, 2),
Cells(EndRow, 2)), "F: " & fFormat) = 0 Then

Cells(StartRow, 2).Offset(Counter, 0).NumberFormatLocal
= fFormat

Cells(StartRow, 2).Offset(Counter, 0).Value = "F: " &

fFormat
Counter = Counter + 1
End If
Next Cell
Next Sh

I only can't figure out, how this exactly works, and how to adjust it.
Changing Cells(StartRow, 2) in Cells(StartRow, 4) is easy but the main
part isn't (for me).

If you find some time? I really did my best to figure it out myself,
but failed to do so.

Kind regards and thanks
Eric

"Leo Heuser" <leo.h...@get2net.dk> schreef in bericht

news:eMR2CF52AHA.2204@tkmsftngp02...