Select Blank Lines In Excel Sheet

IMO

Now Known as ___
Local time
Today, 23:51
Joined
Sep 11, 2002
Messages
723
Does anybody know how to select all the blank lines in an Excel spreadsheet that come after the data and delete them? This may seem like a stupid question (probably is) but here's the story. I'm importing sheet2 of the spreadsheet into Access, deleting certain rows and then exporting back to sheet2 in the spreadsheet, all works fine except when I try to run a DTS package in SQL Server, I get an error. But, if I open the spreadsheet manually and mark up all rows beneath the data and delete them (even though they're blank), the DTS package runs fine :confused:

Very grateful for any help, it's driving me nuts!! Below is the code I'm currently using...
Code:
Sub sCopyRS()

Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Const conMAX_ROWS = 20000
Const conSHT_NAME = "Shipping Details"
Const conWKB_NAME = "H:\BIDataLoad\Supplier Orders.xls"
  Set db = CurrentDb
  Set objXL = New Excel.Application
  Set rs = db.OpenRecordset("Shipping Details", dbOpenSnapshot)
  With objXL
    .Visible = False
    Set objWkb = .Workbooks.Open(conWKB_NAME)
    On Error Resume Next
    Set objSht = objWkb.Worksheets(conSHT_NAME)
    If Not Err.Number = 0 Then
      Set objSht = objWkb.Worksheets.Add
      objSht.Name = conSHT_NAME
    End If
    Err.Clear
    On Error GoTo 0
    intLastCol = objSht.UsedRange.Columns.Count
    With objSht
      .Range(.Cells(2, 1), .Cells(conMAX_ROWS, _
          intLastCol)).ClearContents
      .Range(.Cells(1, 1), _
        .Cells(1, rs.Fields.Count)).Font.Bold = False
      .Range("A2").CopyFromRecordset rs
      
        objXL.ActiveWorkbook.Save
        objXL.ActiveWorkbook.Close
        objXL.Quit
          
    End With
  End With
  Set objSht = Nothing
  Set objWkb = Nothing
  Set objXL = Nothing
  Set rs = Nothing
  Set db = Nothing
End Sub

Thanks
IMO
 
Thanks Fornatian,

I'll let you know what happens.

Cheers
IMO
 
Still no luck :(

any other ideas??

IMO
 
Can we establish where the last row of the data set sits (e.g. if you go down to the bottom of the range and hit Ctrl + the up arrow does this go to the last record. if so we can use that row as a reference and delete all rows below it.
 
Hi Fornatian,
Yes, if I go to the bottom of the range and hit Ctrl + the up arrow it lands on the last record.
The problem is, the last row of data will change every time the DB is opened, so, without the user doing a thing outside the DB and without Excel opening, I need the VB within the DB to find the last line of data in the spreadsheet and delete the blanks below it to the bottom of the sheet. The only thing in the sheet that will remain the same is, it will always use columns A1:G1, never more. Thanks for your time.

IMO
 
Try this...

Code:
Public Sub DeleteSomeRows()
Dim lngFirstBlankRow As Long
lngFirstBlankRow = Range("A1").End(xlDown).Row + 1
Rows(lngFirstBlankRow & ":65536").Delete
End Sub
 
Thanks Ian, that solved it! DTS runs fine now. How odd though, having to delete blanks for the package to run properly :confused: still, works now. Thanks for your help once again

IMO
 
Think I spoke too soon! If I delete 1 supplier from the spreadsheet from within the DB all works fine. However, if I delete more than 1 supplier the sheet does not save and close. Have you any idea why? The code I'm using is below. Thanks in advance.

IMO

Code:
Sub sCopyRS()

Dim objXL As Excel.Application
Dim objWkb As Excel.Workbook
Dim objSht As Excel.Worksheet
Dim db As Database
Dim rs As Recordset
Dim intLastCol As Integer
Dim lngFirstBlankRow As Long
Const conMAX_ROWS = 20000
Const conSHT_NAME = "Shipping Details"
Const conWKB_NAME = "H:\BIDataLoad\Supplier Orders.xls"
  Set db = CurrentDb
  Set objXL = New Excel.Application
  
  Set rs = db.OpenRecordset("Shipping Details", dbOpenSnapshot)
  With objXL
    .Visible = False
    Set objWkb = .Workbooks.Open(conWKB_NAME)
    On Error Resume Next
    Set objSht = objWkb.Worksheets(conSHT_NAME)
    If Not Err.Number = 0 Then
      Set objSht = objWkb.Worksheets.Add
      objSht.Name = conSHT_NAME
    End If
    Err.Clear
    On Error GoTo 0
    intLastCol = objSht.UsedRange.Columns.Count
    With objSht
      .Range(.Cells(2, 1), .Cells(conMAX_ROWS, _
          intLastCol)).ClearContents
      .Range(.Cells(1, 1), _
        .Cells(1, rs.Fields.Count)).Font.Bold = False
      .Range("A2").CopyFromRecordset rs
      
        lngFirstBlankRow = Range("A1").End(xlDown).Row + 1
        Rows(lngFirstBlankRow & ":65536").Delete
        
        objXL.ActiveWorkbook.Save
        objXL.ActiveWorkbook.Close
        objXL.Quit
                  
    End With
  End With
  Set objSht = Nothing
  Set objWkb = Nothing
  Set objXL = Nothing
  Set rs = Nothing
  Set db = Nothing

End Sub
 
Turn your Error Handler back on and see if you get an error message when saving and closing.
 
Thanks for your reply Mile,

I get a 'Type Mismatch' error from Access and nothing is deleted from the spreadsheet :confused:

IMO
 
No lines are highlighted, I only get the message box

IMO
 
Code:
.Range("A2").CopyFromRecordset rs


Are you copying any particular field?
 
I'm just talking crap now - had never seen that command.

I suppose, you can say, this is my first time messing about with Excel from Access. :rolleyes:
 
Last edited:
Thanks for giving it a shot, I'll keep trying and let you know the outcome. Thanks again for your time.

IMO
 
But if you do have any other ideas in the meantime, please let me know, I think I used all three of my brain cells getting this far! :D

IMO
 
Have you used breakpoints to follow through (the code that is :p) , also?
 
No, just followed through :o :D

I'll give that a try in the morning, see where it errors. Ive got to get to the pub now, my head feels like it's gonna explode!

Cheers

IMO
 
OK, I'm now getting the error:

Run-time error '1004'

Method 'Range' of object '_Global' failed.

And the following code line is highlighted
Code:
        lngFirstBlankRow = Range("A1").End(xlDown).Row + 1

Any ideas??

IMO
 

Users who are viewing this thread

Back
Top Bottom