Not deleting headers

[Mauro]

as an aswer to a previous question I've received the following code:

Dim c, sh
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Main_Sheet_Name_Here" Then
For Each c In sh.UsedRange
If Not c.HasFormula Then c.ClearContents
Next c
End If
Next sh

this works fine. The only problem being that row 1 shouldn't be deleted as
it is the header. How can I do that?

thanks

 

[Norman Jones]

Hi Mauro,

Try:

Sub Tester()
Dim c As Range
Dim sh As Worksheet

For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Main_Sheet_Name_Here" Then
For Each c In sh.UsedRange
If Not c.HasFormula And c.Row > 1 _
Then c.ClearContents
Next c
End If
Next sh

End Sub

 

[Guest]

Think this will need to be inseted in your code.
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With

 

[Norman Jones]

Hi Mauro,

Additionally, in the first line of your macro, I would change Sheets to
Worksheets, i.e. change:

For Each sh In ThisWorkbook.Sheets

to

For Each sh In ThisWorkbook.Worksheets

Otherwise the code will engender an error if the workbook contains chart or
dialog sheets.

 

[Norman Jones]

Hi David.

Think this will need to be inseted in your code.
With ActiveSheet.PageSetup
.LeftHeader = ""
.CenterHeader = ""
.RightHeader = ""
.LeftFooter = ""
.CenterFooter = ""
.RightFooter = ""
End With

I think not - unless I have misunderstood Mauro's post!

 

[Guest]

Think you are right Norm, misread it.

Hi David.




I think not - unless I have misunderstood Mauro's post!

 

[Guest]

Think you are right

Hi David.




I think not - unless I have misunderstood Mauro's post!

 

[Mauro]

It works, it works.
The only thing is the speed. It does the whole thing but it does it
increadible slowly

 

[Norman Jones]

Hi Mauro,

It works, it works.
The only thing is the speed. It does the whole thing but it does it
increadible slowly

Try inserting:

Application.ScreenUpdating = False

after the last Dim line

and insert

Application.ScreenUpdating = True

as the last line.

 

[Guest]

Less elegent, but faster...copy the headers to a variant, clear all
constants, then put back the headers....

Sub Tester()
Dim c As Range
Dim sh As Worksheet
Dim headers As Variant
For Each sh In ThisWorkbook.Sheets
If sh.Name <> "Main_Sheet_Name_Here" Then
headers = sh.Rows(1)
sh.UsedRange.SpecialCells(xlCellTypeConstants).ClearContents
sh.Rows(1) = headers
End If
Next sh

End Sub

 

[Sharad]

OK, when I gave you the first code, didn't think that the usedRange will
be so large (as it now seems from your post.). Clearing content of each
cell then moving to next will definately take too long. Therefore I
modified the code to set a Union of all cells having no formula (and not
in the first row) and then in one shot clear the contents.
Use below code. I hope you will find it ultraFast compared to the time
it must be taking with present code.

Sub FastClear()
Dim uRange As Range, clRange As Range
Dim c, sh
For Each sh In ThisWorkbook.Worksheets
If sh.Name <> "Main_Sheet_Name_Here" Then
With sh.UsedRange
Set uRange _
= .Range(.Cells(2, 1), .Cells(.Rows.Count, .Columns.Count))
'This has set the range excluding row 1
Set clRange = .Cells(.Rows.Count + 1, 1)
'an unused cell is assigned to clRange
'so that it can be used in Union method
End With
Set clRange = uRange.Cells(1, 1)
For Each c In uRange.Cells
If Not c.HasFormula Then
Set clRange = Union(clRange, c)
End If
Next c
clRange.ClearContents
End If
Next sh
End Sub

Sharad

 

[Sharad Naik]

Now, that's so straight forward.
Never looked at SpecialCells method.
Guess I need to look in to it seriously, looks like
will definately help in cutting my codes short.

Sharad

 

[Mauro]

it works perfectly now, thanks to you all for your help