range variable across sheets

[Ward Germonpré]

Hi,

The routine below makes sure that there are exactly 2 blanc rows between
square blocks of data.
It iterates over all blocks that are currently seperated by 1 or more
blanc rows and either inserts or deletes blanc rows accordingly.
Unfortunately it only works on the first sheet.
Apparently this statement :

Set celbottom = .Cells(65536, 1).End(xlUp)

continues to refer to the first sheet, although it is inside a for each
loop that iterates over all sheets.


Thanks for any help


Ward




Public Sub rowrijen()
Dim celbottom As Range, celtop As Range, bereik As Range
Dim ws As Worksheet
Dim adres As String

For Each ws In Worksheets
With ws
If .Name <> "synthese" Then
Set celbottom = .Cells(65536, 1).End(xlUp)
Set celbottom = celbottom.End(xlUp)
Do Until celbottom.Row = 1
Set celbottom = celbottom.Offset(-1, 0)
Set celtop = celbottom.End(xlUp)
Set celtop = celtop.Offset(1, 0)
adres = celtop.Address
Set bereik = Range(celbottom, celtop)
If bereik.Rows.Count >= 2 Then
Do While bereik.Rows.Count > 2
.Range(adres).EntireRow.Delete
Loop
Else
.Range(adres).EntireRow.Insert
End If
Set celbottom = Range(adres).End(xlUp)
Set celbottom = celbottom.End(xlUp)
Loop

End If
End With
Next
End Sub

 

[Bob Phillips]

No it refers to ws.

However, perhaps this

Set bereik = Range(celbottom, celtop)

should be changed to

Set bereik = .Range(celbottom, celtop)

and also

Set celbottom = Range(adres).End(xlUp)

to

Set celbottom = .Range(adres).End(xlUp)

to sort the problem

--

HTH

RP
(remove nothere from the email address if mailing direct)

 

[Tom Ogilvy]

Even though in the loop, an unqualified range refers to the activesheet. I
added periods in front of the reference.

Public Sub rowrijen()
Dim celbottom As Range, celtop As Range, bereik As Range
Dim ws As Worksheet
Dim adres As String

For Each ws In Worksheets
With ws
If .Name <> "synthese" Then
Set celbottom = .Cells(65536, 1).End(xlUp)
Set celbottom = celbottom.End(xlUp)
Do Until celbottom.Row = 1
Set celbottom = celbottom.Offset(-1, 0)
Set celtop = celbottom.End(xlUp)
Set celtop = celtop.Offset(1, 0)
adres = celtop.Address
Set bereik = Range(celbottom, celtop)
If bereik.Rows.Count >= 2 Then
Do While bereik.Rows.Count > 2
.Range(adres).EntireRow.Delete
Loop
Else
.Range(adres).EntireRow.Insert
End If
Set celbottom = .Range(adres).End(xlUp)
Set celbottom = .celbottom.End(xlUp)
Loop

End If
End With
Next
End Sub

 

[Kingalbertii]

Mystery solved.

Thanks !