Find last row & last column of changing range

[RJS]

The following code copies data from Excel & pastes it as unformatted text into a new Word doc.

The range to be copied will always start at A15, but can consist of any number of rows & any number of columns up to & including H, e.g. A15:C300, A15:E20, A15:H2000, etc.

My problem is to find the last row & column with data.

The code below doesn't work properly -- the range selected includes cells with no visible data (false positives?), which create problems when copied into the Word doc.

Any help greatly appreciated! I'm a mere cutter & paster with little knowledge of VBA, so please feel free to underestimate my level of expertise.

______________________
Sub report()
Dim Rng As Range
Dim LastRow As Long
Range("A65536").Select
ActiveCell.End(xlUp).Select
LastRow = ActiveCell.Row
Set Rng = Range("A15" & ":" & "H" & LastRow)
Application.Goto Reference:=Rng
Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
Selection.Copy
'open Word & paste
Dim appWD As Word.Application
Set appWD = CreateObject("Word.Application")
appWD.Visible = True
appWD.Documents.Add
appWD.Selection.PasteAndFormat (wdPasteDefault)
End Sub

 

[Richie(UK)]

Hi RJS,

Welcome to the board.

I'm not too hot on the formatting of the pasted information in Word but I think this routine should do most of what you wanted.

<pre>
Sub report()
Dim Rng As Range
Dim LastRow As Long
Dim LastColumn As Integer
Dim appWD As Object 'keep all Dim items at the start

'/// Find the last row ///
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Rows.
LastRow = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious).Row
End If

'/// Find the last column ///
If WorksheetFunction.CountA(Cells) > 0 Then
'Search for any entry, by searching backwards by Columns.
LastColumn = Cells.Find(What:="*", After:=[A1], _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious).Column
If LastColumn > 8 Then LastColumn = 8 'No further than "H"
End If

Set Rng = Range(Cells(15, 1), Cells(LastRow, LastColumn))
Rng.Copy

'open Word & paste
Set appWD = CreateObject("Word.Application")
appWD.Visible = True
appWD.Documents.Add
appWD.Selection.Paste

Application.CutCopyMode = False 'release memory from Clipboard
Set appWD = Nothing 'release memory from object variable

End Sub

</pre>

HTH

 

[RJS]

Thanks for that, Richie! It works fine, except that I still have rogue blank rows & columns in the Word document.

I'm wondering whether some ranges which are used in previous operations in the source spreadsheet are creating the problem (a separate macro to select the data to be copied precedes the one I gave above).

I may see if I can build back some of your macro's logic into the previous macro to prevent this (i.e. to avoid using pre-set ranges).

Thanks again!