Macro to find empty cell and paste in that row

wyester · #1 (**permalink**) 01-12-11, 12:14

Hi all, I have a need for a macro that does the following:

Predefined Range “Contents” = B7 – X66
1. Search Column C of “Contents” for the first empty cell (from the top)
2. Copy a Row (Column B to Column X) from a set location (C100 – X100).
3. Paste in the empty row
4. Select the newly pasted row
5. Replace “1” with “B[EmptyRow] – there is a number in B regardless of whether C is empty.

Thanks!

I have posted below what I have - this pastes the new row into a static #39 - the trouble I'm having is making this row # dynamic based on which row is empty. The number 39 is in Column B and represents a project number which points coresponds to a worksheet of the same name.

Quote:

Sub AddContents()
'
' AddContents Macro
'

'
Range("C100:X100").Select
Range("L100").Activate
Selection.Copy
Range("C45:X45").Select
ActiveSheet.Paste
Selection.Replace What:="'1'", Replacement:="'39'", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub

Colin Legg · #2 (**permalink**) 01-19-11, 13:35

Hi,

Quote:

the trouble I'm having is making this row # dynamic based on which row is empty.

......

Search Column C of “Contents” for the first empty cell (from the top)

You can use the Range.SpecialCells() method to find the first empty cell in column C. There are a few caveats you have to be aware of when using this method; we can defensively code for them and wrap it up in a function:

Code:

Sub foo()
 
    Dim rngEmptyCell As Range
 
    'what is the first empty cell in column C?
    Set rngEmptyCell = GetFirstEmptyCell(Sheet1.Range("C:C"))
 
    If rngEmptyCell Is Nothing Then
        MsgBox "There are no empty cells in column C"
    Else
        MsgBox rngEmptyCell.Address
    End If
 
End Sub
 
Function GetFirstEmptyCell(ByVal rngToCheck As Range) As Range
 
    If Application.Intersect(rngToCheck.Parent.UsedRange, rngToCheck) Is Nothing Then
        Set GetFirstEmptyCell = rngToCheck.Cells(1)
    Else
        If rngToCheck.Count > 1 Then
            'if there are no blank cells then there will be an error
            On Error Resume Next
            Set GetFirstEmptyCell = rngToCheck.SpecialCells(xlCellTypeBlanks).Cells(1)
            On Error GoTo 0
        Else
            If VBA.IsEmpty(rngToCheck) Then Set GetFirstEmptyCell = rngToCheck
        End If
    End If
 
End Function

Hope that helps...

Internet Services

Web Development

Digital Marketing

Consumer Tech