Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Finding the first blank row, and copying to it..

Status
Not open for further replies.

Morglisn

Technical User
Jun 20, 2003
6
0
0
US
Hey, guys.

I'm trying to have my script find the first available blank row, and copy the row immediately above it (formulas and formats only) onto the blank row. Any ideas on how to go about this? And take it easy on me, I'm fairly new to VBA.

Thanks!!
 
Hi,

Code:
    With ActiveSheet.UsedRange
       lastrow = .Row + .Rows.Count - 1
       .Range(.Cells(lastrow, 1), .Cells(lastrow, .Columns.Count)).Copy
       .Cells(lastrow + 1, 1).Select
       ActiveSheet.Paste
    End With
Hope this helps :)

Skip,
Skip@TheOfficeExperts.com
 
Forgive my ignorance, but I'm not sure how this bit o' code works. When I use it, it's skipping me to row 118 or 119 and copying the row above that. Is there something important I'm missing?

Thanks!!!
 
You must have other stuff in your worksheet. UsedRange looks at the entire worksheet and in the case of this code, identifies the last row of data.

You have to tell me more about your worksheet.

Skip,
Skip@TheOfficeExperts.com
 
'To get to the last cell with characters in it
Selection.End(xlDown).Select
'To Select the entire row you want to copy
ActiveCell.EntireRow.Select
Selection.Copy
'To go to the blank line after the cell
ActiveCell.Offset(1, 0).Select
'To select the row to paste
ActiveCell.EntireRow.Select
'To paste the formats
Selection.PasteSpecial Paste:=xlFormats, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
'To Paste the formulas
Selection.PasteSpecial Paste:=xlFormulas, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=False

Note: You have to choose which column contains the correct information and this assumes that the entire row is blank if the cell is blank in one column.

Hope it helps
 
Here is a synthesis of both approaches wrapped up in one. It doesn't matter whether you have stray formatting or not. And it doesn't require a column of data without blanks. It simply does what you requested. If your first data entry cell is not in column "A" adjust the final .Select operation in the main Sub.
[blue]
Code:
Option Explicit

Sub SetupNewLine()
[green]
Code:
' Generic macro to copy last line of the active sheet to
' the (empty) line below (formulas and formatting only).
[/color]
Code:
Dim nLastRow As Long
[green]
Code:
  ' Find where to paste
[/color]
Code:
  nLastRow = LastRow(ActiveSheet)
[green]
Code:
  ' Copy and paste
[/color]
Code:
  ActiveSheet.Cells(nLastRow, 1).EntireRow.Copy
  Cells(nLastRow + 1, 1).Select
  Selection.PasteSpecial Paste:=xlFormats
  Selection.PasteSpecial Paste:=xlFormulas
  Application.CutCopyMode = False
  Cells(nLastRow + 1, 1).Select
End Sub

Function LastRow(AWorksheet As Worksheet) As Long
[green]
Code:
' Generic function to find the last actually used row
' in a worksheet.  "UsedRange" is taken for the first
' approximation.  Then rows are then tested for the
' presence of actual data with the CountA function.
' Rows that only have formatting, colors, patterns,
' borders, etc. are ignored.
' Returns zero if there is no data in the sheet
' or if there is invalid input.
[/color]
Code:
Dim bCheckingForBadUsedRange As Boolean
  If AWorksheet Is Nothing Then
    MsgBox "LastRow function called without a valid Worksheet object."
    LastRow = 0
  Else
    With AWorksheet.UsedRange
      LastRow = .Rows.Count + .Row - 1
    End With
    bCheckingForBadUsedRange = True
    While bCheckingForBadUsedRange And LastRow > 0
      If LastRow > 0 And WorksheetFunction.CountA(Cells(LastRow, 1).EntireRow) = 0 Then
        LastRow = LastRow - 1
      Else
        bCheckingForBadUsedRange = False
      End If
    Wend
  End If
End Function
[/color]

 
Thanks, guys. I didn't copy your code, but I learned enough from it to make it work. Great forum, people...

 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top