Lowell In the south
Board Regular
- Joined
- Sep 26, 2002
- Messages
- 55
This is a some code the ALL Knowing, Wise and Kind Rikrak helped me with.
Private Sub QS_Window_Finish_Click()
If QS_Window_Finish.Value = True Then
Dim Rg As Range
Dim cl As Range
Range("Quote_Window_Finish").Copy
Range("Quote_Window_Finish").Select
cn = Range("Quote_Window_Finish").Columns.Count
rn = Range("Quote_Window_Finish").Rows.Count
Set Rg = Range("Quote_Top_Range")
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
End If
End Sub
I have this same code 15 times behind a user form with checkboxes, using the same range to check for blank,unmerged, visible cells but using diffrent cells to copy and paste in to that range.
It is works off of a checkbox.If it is checked it copies a two cell tall three cell long merged range counts the number of rows and columns. Then it checks a range for enough room to paste that is blank, unmerged, and visible and pastes. If there is not enough room it "returns" and starts on the next row that has enough room. THIS WORKS great as long as the range I am checking and the range I am pasting work out even. For example my range is 20 columns wide and my paste range of merged cells is 2 columnus wide it pastes 10 times and then returns and works great. However I am using this to paste diffrent size merged ranges to the same range. Some are 4 columnus wide some are 5, 3,7 so it is impossible to ensure that it will always work out even. When it does not i get an error = 2023 message on the first IF cl = "" line.
I hope this made sense HELP!!!!
_________________
The KING lives on at Graceland!
This message was edited by Lowell In the south on 2002-10-11 12:09
This message was edited by Lowell In the south on 2002-10-11 12:10
Private Sub QS_Window_Finish_Click()
If QS_Window_Finish.Value = True Then
Dim Rg As Range
Dim cl As Range
Range("Quote_Window_Finish").Copy
Range("Quote_Window_Finish").Select
cn = Range("Quote_Window_Finish").Columns.Count
rn = Range("Quote_Window_Finish").Rows.Count
Set Rg = Range("Quote_Top_Range")
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
End If
End Sub
I have this same code 15 times behind a user form with checkboxes, using the same range to check for blank,unmerged, visible cells but using diffrent cells to copy and paste in to that range.
It is works off of a checkbox.If it is checked it copies a two cell tall three cell long merged range counts the number of rows and columns. Then it checks a range for enough room to paste that is blank, unmerged, and visible and pastes. If there is not enough room it "returns" and starts on the next row that has enough room. THIS WORKS great as long as the range I am checking and the range I am pasting work out even. For example my range is 20 columns wide and my paste range of merged cells is 2 columnus wide it pastes 10 times and then returns and works great. However I am using this to paste diffrent size merged ranges to the same range. Some are 4 columnus wide some are 5, 3,7 so it is impossible to ensure that it will always work out even. When it does not i get an error = 2023 message on the first IF cl = "" line.
I hope this made sense HELP!!!!
_________________
The KING lives on at Graceland!
This message was edited by Lowell In the south on 2002-10-11 12:09
This message was edited by Lowell In the south on 2002-10-11 12:10