check for room between blank cells to paste merged range

[Lowell In the south]

Here is a bit of code the ALL knowing Rikrak helpe me with

Dim Rg As Range
Dim cl As Range
Range("Aq15:As16").Copy

Set Rg = Range("A10:x18")
For Each cl In Rg
If cl = "" And cl.MergeArea.Columns.Count = 1 And Not cl.EntireColumn.Hidden And Not cl.EntireRow.Hidden Then
found = True
cl.Select
Exit For
End If
Next
If found Then
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
MsgBox "Not enough room at top of quote contact LRBII"
End If

It copies a merged range then checks a range of cells that include hidden columns for the first blank unmerged cell that is visible then pastes the copied merged range. It works.
PROBLEM: If my copied merged range is 4 cells long and the frist blank unmerged cell is just prior to three hidden cells it will paste the copied range. when there is really not enought room to properly display the informtion.
QUESTION: How could I run a check on the next 3 cell after the first blank cell that is visible?
somthing like this??? After the first If statment?
'If (cl + the next cell) = SpecialCells(xlCellTypeVisible) Then

THANKS in advance for your help!!!!!
This message was edited by Lowell in the south on 2002-10-06 11:41
This message was edited by Lowell in the south on 2002-10-06 13:55

 

[rikrak]

Dim Rg As Range
Dim cl As Range
Range("Aq15:As16").Copy
Range("Aq15:As16").Select

cn = Range("Aq15:As16").Columns.Count
rn = Range("Aq15:As16").Rows.Count

Set Rg = Range("A10:x18")
c = Rg.Column + Rg.Columns.Count
r = Rg.Row + Rg.Rows.Count

For Each cl In Rg
If cl = "" And cl.MergeArea.Columns.Count = 1 And Not cl.EntireColumn.Hidden And Not cl.EntireRow.Hidden And cl.Column <= c - cn And cl.Row <= r - rn Then
found = True
For i = 1 To cn - 1
If cl.Offset(0, i).EntireColumn.Hidden Then found = False
Next
For i = 1 To rn - 1
If cl.Offset(i, 0).EntireRow.Hidden Then found = False
Next
If found Then Exit For
End If
Next
If found Then
cl.Select
Selection.PasteSpecial Paste:=xlAll, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Else
MsgBox "Not enough room at top of quote contact LRBII"
End If

 

[Lowell In the south]

It works GREAT!!!! I have been working on this project for a month this will allow me to finish it. THANKS!!!!!!!!!