PDA

View Full Version : Solved: Find Empty Column Range



NorthernFrog
08-19-2009, 05:35 AM
I've a table in Sheet1 containing range M12:M34. Any number of the cells M12:M31 may be empty, but there will always be values in M32:M34. Each time the data in this range changes I want to paste the new values into a summary table on Sheet2, beginning at the first empty range D8:30 and continuing to R8:R30. Bounding the top and both sides of the paste range there is data in every cell of the ranges B6:S7 (header labels), B8:C29 (B-labels, C-values), and S8:S30 (calculations based on pasted data).

I've searched similar posts here and figured out how to paste the first instance to column D, though it pastes regardless of whether there is already data in the range. Two days of trial and error has not yet produced a workable solution to how to paste into ranges beyond the first so it's time to ask for help.

A recent example of what hasn't worked:



Sub CopytoSummary()
Dim _
wksSource As Worksheet, _
wksDest As Worksheet, _
rngFind As Range, _
lColFind As Long

Set wksSource = ThisWorkbook.Worksheets("Sheet1")
Set wksDest = ThisWorkbook.Worksheets("Sheet2")

Set rngFind = wksDest.Columns("D:R").Find(What:="", _
After:=wksSource.Range("D7"), _
LookIn:=xlFormulas, _
LookAt:=xlWhole, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlNext)

If Not rngFind Is Nothing Then
lColFind = 4
wksSource.Range("M12:M34").Copy
rngFind.PasteSpecial Paste:=xlPasteValues

Else
lColFind = rngFind.Column + 1
wksSource.Range("M12:M34").Copy
rngFind.PasteSpecial Paste:=xlPasteValues

End If

Application.CutCopyMode = False

End Sub


Also, have tried to adapt code from a thread where poster was searching for blanks in a row range, but returned various errors and in this version it's the pastespecial method that fails.



Dim rng As Range, Newrng As Range
Set rng = Sheets("sheet1").Range("M12:M34")
Set Newrng = Sheets("sheet2").Cells(8, Sheets("sheet2").Range("30").End(xlToLeft).Column).Offset(0, 1)
rng.Copy
With Newrng
.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
With Sheets("Instruction")
Application.CutCopyMode = False
End With

CHatmaker
08-19-2009, 09:56 AM
Sub CopytoSummary()
Dim _
wksSource As Worksheet, _
wksDest As Worksheet

Set wksSource = ThisWorkbook.Worksheets("Sheet1")
Set wksDest = ThisWorkbook.Worksheets("Sheet2")

For lCol = 4 To 18 'D thru R
wksDest.Activate
If Is_Range_Blank(wksDest.Range(Cells(8, lCol), Cells(30, lCol))) Then
wksSource.Range("M12:M34").Copy
wksDest.Range(Cells(8, lCol), Cells(30, lCol)).PasteSpecial Paste:=xlPasteValues
Exit For
End If
Next
End Sub


Function Is_Range_Blank(rngRange As Range) As Boolean
Dim c As Range

Is_Range_Blank = True 'Assume it is blank

For Each c In rngRange
If Len(Trim(c)) > 0 Then
Is_Range_Blank = False
Exit Function
End If
Next
End Function

NorthernFrog
08-19-2009, 10:17 AM
Thank-you CHatmaker it works perfectly!

CHatmaker
08-19-2009, 03:08 PM
You're welcome