Add good amout of rows in Grid

Hello all,

I need your help to adjust a code that i have.

With the code bellow, i export an excel spreadsheet into a grid. The only problem that i have is that i have to put tell the grid manually how many row i need to import all lines from the excel spreadsheet.

I would like the code to automatically adjust himself with the good amount of rows.

How can i do this please?

Thanks again for your help.
Dim xlObject    As Excel.Application
Dim xlWB        As Excel.Workbook
On Error GoTo MyErrHandler

    With CommonDialog1
        .CancelError = True
        .Filter = "Microsoft Excel files (xlam, xlsx, xltm, xlt, xlsm, xltx, xls, txt, csv)"
        '.InitDir = App.Path
        .InitDir = "C:\Documents and Settings\all users\Desktop"
        .ShowOpen
        If Not .FileName = "" Then
            Set xlObject = New Excel.Application
            Set xlWB = xlObject.Workbooks.Open(.FileName)
          
   Clipboard.Clear
  
   With xlObject.ActiveWorkbook.ActiveSheet
       .Range("A1:Bj10000").Copy 'Set selection to Copy
   End With
   With fg
       .Redraw = False     'Dont draw until the end, so we avoid that flash
       .Row = 0            'Paste from first cell
       .Col = 0
       .RowSel = .Rows - 1 'Select maximum allowed (your selection shouldnt be greater than this)
       .ColSel = .Cols - 1
       .Clip = Replace(Clipboard.GetText, vbNewLine, vbCr) 'Replace carriage return with the correct one
       .Col = 1            'Just to remove that blue selection from Flexgrid
       .Redraw = True      'Now draw
     
   End With
      
   xlObject.DisplayAlerts = False 'To avoid "Save woorkbook" messagebox
   'Close Excel
   xlWB.Close
   xlObject.Application.Quit
   Set xlWB = Nothing
    Set xlObject = Nothing
    
     End If
    End With
    
    Exit Sub
    


MyErrHandler:
    Err.Clear
    
    End If

Open in new window

LVL 11
Wilder1626Asked:
Who is Participating?

[Product update] Infrastructure Analysis Tool is now available with Business Accounts.Learn More

x
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

KarenAnalyst programmerCommented:

See below for a good way to find the "last" cell.
You would then call this function:

Dim xlRange  As Excel.Range

Set xlRange = LastCell(xlObject.ActiveWorkbook.ActiveSheet)
xlRange.Copy 'Set selection to Copy


=======

Function LastCell(ws As Excel.Worksheet) As Excel.Range
  Dim LastRow&, LastCol%

' Error-handling is here in case there is not any
' data in the worksheet

  On Error Resume Next

  With ws

  ' Find the last real row

    LastRow& = .Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByRows).Row

  ' Find the last real column

    LastCol% = .Cells.Find(What:="*", _
      SearchDirection:=xlPrevious, _
      SearchOrder:=xlByColumns).Column

  End With

' Finally, initialize a Range object variable for
' the last populated row.

  Set LastCell = ws.Cells(LastRow&, LastCol%)

End Function

Wilder1626Author Commented:
What do i need to do with the code?

Do i need to combine it to the code that i have?
KarenAnalyst programmerCommented:
Well...I was assuming that since you posted with VB6 in the tag, that you were writing in vb6? Where do you have your code? Within the code you gave, you would put the function call like this:

Dim xlObject    As Excel.Application
Dim xlWB        As Excel.Workbook
Dim xlRange  As Excel.Range

On Error GoTo MyErrHandler

    With CommonDialog1
        .CancelError = True
        .Filter = "Microsoft Excel files (xlam, xlsx, xltm, xlt, xlsm, xltx, xls, txt, csv)"
        '.InitDir = App.Path
        .InitDir = "C:\Documents and Settings\all users\Desktop"
        .ShowOpen
        If Not .FileName = "" Then
            Set xlObject = New Excel.Application
            Set xlWB = xlObject.Workbooks.Open(.FileName)
         
   Clipboard.Clear
 
   ' New code here
   Set xlRange = LastCell(xlObject.ActiveWorkbook.ActiveSheet)
   xlRange.Copy 'Set selection to Copy


   With fg
       .Redraw = False     'Dont draw until the end, so we avoid that flash
       .Row = 0            'Paste from first cell
       .Col = 0
       .RowSel = .Rows - 1 'Select maximum allowed (your selection shouldnt be greater than this)
       .ColSel = .Cols - 1
       .Clip = Replace(Clipboard.GetText, vbNewLine, vbCr) 'Replace carriage return with the correct one
       .Col = 1            'Just to remove that blue selection from Flexgrid
       .Redraw = True      'Now draw
     
   End With
     
   xlObject.DisplayAlerts = False 'To avoid "Save woorkbook" messagebox
   'Close Excel
   xlWB.Close
   xlObject.Application.Quit
   Set xlWB = Nothing
    Set xlObject = Nothing
   
     End If
    End With
   
    Exit Sub
   


MyErrHandler:
    Err.Clear
   
    End If
Determine the Perfect Price for Your IT Services

Do you wonder if your IT business is truly profitable or if you should raise your prices? Learn how to calculate your overhead burden with our free interactive tool and use it to determine the right price for your IT services. Download your free eBook now!

Wilder1626Author Commented:
Good, i don't have any error.

But, Once i select the excel spreadsheet, it does not transfer to my Msflexgrig (fg).

KarenAnalyst programmerCommented:
I'm sorry, I have made that far more complicated than it needs to be.... you do not need the new function I gave you.

Dim xlObject    As Excel.Application
Dim xlWB        As Excel.Workbook
On Error GoTo MyErrHandler

    With CommonDialog1
        .CancelError = True
        .Filter = "Microsoft Excel files (xlam, xlsx, xltm, xlt, xlsm, xltx, xls, txt, csv)"
        '.InitDir = App.Path
        .InitDir = "C:\Documents and Settings\all users\Desktop"
        .ShowOpen
        If Not .FileName = "" Then
            Set xlObject = New Excel.Application
            Set xlWB = xlObject.Workbooks.Open(.FileName)
         
   Clipboard.Clear

 
' This is all you need to do
xlObject.Cells.Copy        'Set selection to Copy


   With fg
       .Redraw = False     'Dont draw until the end, so we avoid that flash
       .Row = 0            'Paste from first cell
       .Col = 0
       .RowSel = .Rows - 1 'Select maximum allowed (your selection shouldnt be greater than this)
       .ColSel = .Cols - 1
       .Clip = Replace(Clipboard.GetText, vbNewLine, vbCr) 'Replace carriage return with the correct one
       .Col = 1            'Just to remove that blue selection from Flexgrid
       .Redraw = True      'Now draw
     
   End With
     
   xlObject.DisplayAlerts = False 'To avoid "Save woorkbook" messagebox
   'Close Excel
   xlWB.Close
   xlObject.Application.Quit
   Set xlWB = Nothing
    Set xlObject = Nothing
   
     End If
    End With
   
    Exit Sub
   


MyErrHandler:
    Err.Clear
   
    End If
KarenAnalyst programmerCommented:
Here is a version which will create the right number of rows and columns in the flex grid:

Dim xlObject     As Excel.Application
Dim xlWB         As Excel.Workbook
Dim NoOfRows     As Long
Dim NoOfColumns  As Long

    On Error GoTo MyErrHandler
   
    With CommonDialog1
        .CancelError = True
        .Filter = "Microsoft Excel files (xlam, xlsx, xltm, xlt, xlsm, xltx, xls, txt, csv)"
        .InitDir = "C:\Documents and Settings\all users\Desktop"
        .ShowOpen
        If Not .FileName = "" Then
            Set xlObject = New Excel.Application
            Set xlWB = xlObject.Workbooks.Open(.FileName)

            Clipboard.Clear
            xlObject.Cells.Copy     ' Copy all cells in active worksheet.
            FetchNoRowCol xlObject.ActiveWorkbook.ActiveSheet, NoOfRows, NoOfColumns
            With fg
               .Redraw = False     'Dont draw until the end, so we avoid that flash
               .Rows = NoOfRows
               .Cols = NoOfColumns
               .Row = 0            'Paste from first cell
               .Col = 0
               .RowSel = .Rows - 1 'Select maximum allowed (your selection shouldnt be greater than this)
               .ColSel = .Cols - 1
               .Clip = Replace(Clipboard.GetText, vbNewLine, vbCr) 'Replace carriage return with the correct one
               .Col = 1            'Just to remove that blue selection from Flexgrid
               .Redraw = True      'Now draw
            End With
            xlObject.DisplayAlerts = False 'To avoid "Save woorkbook" messagebox
            xlWB.Close
            xlObject.Application.Quit
            Set xlWB = Nothing
            Set xlObject = Nothing
        End If
    End With
   
    Exit Sub

MyErrHandler:
    Err.Clear
End Sub

Private Sub FetchNoRowCol(ws As Excel.Worksheet, ByRef NoOfRows As Long, _
        ByRef NoOfColumns As Long)
    ' Error-handling is here in case there is not any
    ' data in the worksheet.
    On Error Resume Next
   
    NoOfRows = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, _
            SearchOrder:=xlByRows).Row
    NoOfColumns = ws.Cells.Find(What:="*", SearchDirection:=xlPrevious, _
            SearchOrder:=xlByColumns).Column
End Sub

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Wilder1626Author Commented:
Oh yes.

Perfect and thanks a lot.
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Visual Basic Classic

From novice to tech pro — start learning today.