VB - Some problem when extractive data from MSHFlexgrid1 to excel

I just found what happened

I was able to fix it by doing this:

    Dim i As Long
    Dim txt As String

    For i = 1 To MSHFlexGrid1.Rows - 1

        txt = MSHFlexGrid1.TextMatrix(i, 6)

        If InStr(txt, Chr(13)) Then
            txt = Replace(txt, Chr(13), " ")
            MSHFlexGrid1.TextMatrix(i, 6) = txt
            'MSHFlexGrid1.Row = i
            'MSHFlexGrid1.Col = 6
            'MSHFlexGrid1.CellBackColor = vbYellow
        End If

    Next i

Select allOpen in new window

This is because when i was entering data in my MSHFlexgrid1, i wanted to click on ENTER to go on the next row automatically instead of clicking on the arrow down.

If KeyAscii = 13 Then
       On Error Resume Next
            MSHFlexGrid1.Row = MSHFlexGrid1.Row + 1

    End If

Select allOpen in new window

Hi aikimark

ok i will read the details and give it a try. I will let you know the results.

sometime, it may take a while to past in my excel file as i may have more than 4000 ows of that. From what i see, it way increase the performance by using an array. Correct?

Thanks

Where do i say to get in data from my MSHFlexgrid1?

 Dim lngLoop As Long
  Dim lngChunk As Long
  Dim rngChunk As Object
  Dim lngCol As Long
  Dim lngChunkSize As Long
  
  lngChunkSize = 5000 \ UBound(parmData, 1)
  
  If UBound(parmData, 2) > lngChunkSize Then
    ReDim DataForRange(1 To lngChunkSize, LBound(parmData, 1) To UBound(parmData, 1)) 
    For lngChunk = 1 To (UBound(parmData, 2) - (UBound(parmData, 2) Mod lngChunkSize)) Step lngChunkSize
      For lngLoop = 1 To lngChunkSize
        For lngCol = LBound(parmData, 1) To UBound(parmData, 1)
          DataForRange(lngLoop, lngCol) = sngData(lngCol, lngLoop + (lngChunk - 1)) 
        Next
      Next
      Set rngChunk = parmRange.Range(parmRange.Offset(lngChunk - 1, 0), parmRange.Offset(lngChunk - 1 + lngChunkSize, 1))
      rngChunk.Value = DataForRange   
      
      lblStatus.Caption = "Now at Excel row " & lngChunk & " of " & UBound(parmData, 2) & " rows"
    Next
    
    'last little chunk
    ReDim DataForRange(1 To (UBound(parmData, 2) Mod lngChunkSize), LBound(parmData, 1) To UBound(parmData, 1)) 'UBound(sngData, 2) - 1)
    For lngLoop = 1 To (UBound(parmData, 2) Mod lngChunkSize)  
      For lngCol = LBound(parmData, 1) To UBound(parmData, 1)
        DataForRange(lngLoop, lngCol) = sngData(lngCol, lngLoop + (lngChunk - 1)) 
      Next
    Next
    Set rngChunk = parmRange.Range(parmRange.Cells(lngChunk, 1), parmRange.Cells(lngChunk - 1 + (UBound(parmData, 2) Mod lngChunkSize), 2))
    rngChunk.Value = DataForRange 
  
  Else
    
    'only little chunk
    lngChunk = 1
    ReDim DataForRange(1 To UBound(parmData, 2), LBound(parmData, 1) To UBound(parmData, 1))
    For lngLoop = 1 To (UBound(parmData, 2) Mod lngChunkSize)
      For lngCol = LBound(parmData, 1) To UBound(parmData, 1)
        DataForRange(lngLoop, lngCol) = sngData(lngCol, lngLoop + (lngChunk - 1))
      Next
    Next
    Set rngChunk = parmRange.Range(parmRange.Cells(lngChunk, 1), parmRange.Cells(lngChunk - 1 + UBound(parmData, 2), 2))
    rngChunk.Value = DataForRange  
  
  End If

Select allOpen in new window

You directly assign the value property of a range to the textmatrix array.
Example:

rngChunk.Value = gridname.textmatrix

Select allOpen in new window

No looping required.  Just push the data directly from the grid into the Excel range.

If you know the upper left corner of the destination range, you would probably do something like this:

wksTgt.Range(rngTgt.Cells(1,1),rngTgt.Cells(gridname.textmatrix.rows.count,gridname.textmatrix.columns.count)).Value = gridname.textmatrix

Select allOpen in new window

Where wksTgt is the target worksheet.  This example is not meant to be syntactically correct, but to show the general data transfer statement.  For instance, if the grid doesn't have a rows.count property then you will need to use the UBound() function.

I've replaced it to rngChunk.Value = MSHFlexgrid1.textmatrix

But i have this incompatible type error message, and it links to sngData.

Would you have an idea what cause this?

 

 BulkLoad rngOut, sngData

Select allOpen in new window

Full code:

 Dim lngLoop As Long
  Dim lngChunk As Long
  Dim rngChunk As Object
  Dim lngCol As Long
  Dim lngChunkSize As Long
  
  lngChunkSize = 5000 \ UBound(parmData, 1)
  
  If UBound(parmData, 2) > lngChunkSize Then
    ReDim DataForRange(1 To lngChunkSize, LBound(parmData, 1) To UBound(parmData, 1))
    For lngChunk = 1 To (UBound(parmData, 2) - (UBound(parmData, 2) Mod lngChunkSize)) Step lngChunkSize
      For lngLoop = 1 To lngChunkSize
        For lngCol = LBound(parmData, 1) To UBound(parmData, 1)
          DataForRange(lngLoop, lngCol) = sngData(lngCol, lngLoop + (lngChunk - 1))
        Next
      Next
      Set rngChunk = parmRange.Range(parmRange.Offset(lngChunk - 1, 0), parmRange.Offset(lngChunk - 1 + lngChunkSize, 1))
      rngChunk.Value = MSHFlexGrid1.TextMatrix
      
      lblStatus.Caption = "Now at Excel row " & lngChunk & " of " & UBound(parmData, 2) & " rows"
    Next
    
    'last little chunk
    ReDim DataForRange(1 To (UBound(parmData, 2) Mod lngChunkSize), LBound(parmData, 1) To UBound(parmData, 1)) 'UBound(sngData, 2) - 1)
    For lngLoop = 1 To (UBound(parmData, 2) Mod lngChunkSize)
      For lngCol = LBound(parmData, 1) To UBound(parmData, 1)
        DataForRange(lngLoop, lngCol) = sngData(lngCol, lngLoop + (lngChunk - 1))
      Next
    Next
    Set rngChunk = parmRange.Range(parmRange.Cells(lngChunk, 1), parmRange.Cells(lngChunk - 1 + (UBound(parmData, 2) Mod lngChunkSize), 2))
    rngChunk.Value = MSHFlexGrid1.TextMatrix
  
  Else
    
    'only little chunk
    lngChunk = 1
    ReDim DataForRange(1 To UBound(parmData, 2), LBound(parmData, 1) To UBound(parmData, 1))
    For lngLoop = 1 To (UBound(parmData, 2) Mod lngChunkSize)
      For lngCol = LBound(parmData, 1) To UBound(parmData, 1)
        DataForRange(lngLoop, lngCol) = sngData(lngCol, lngLoop + (lngChunk - 1))
      Next
    Next
    Set rngChunk = parmRange.Range(parmRange.Cells(lngChunk, 1), parmRange.Cells(lngChunk - 1 + UBound(parmData, 2), 2))
    rngChunk.Value = MSHFlexGrid1.TextMatrix
  
  End If

Select allOpen in new window

I do not know what Bulkload is.

If you are transferring the textmatrix, why do you need to do anything else?  I don't see any need to reference sngData.

If you need to transfer sngData instead of your textmatrix, then do that.  I do not know why you would do that.

Sorry if i'm slow but i don't fully understand the process than.

May be harder than i thought based on my low experience in VB6

What is the link between the code:

Private Sub BulkLoad(parmRange As Object, parmData() As Single)
  Dim DataForRange() As Single    'may need Variant in future
Dim lngLoop As Long
  Dim lngChunk As Long
  Dim rngChunk As Object
  Dim lngCol As Long
  Dim lngChunkSize As Long
  
  lngChunkSize = 5000 \ UBound(parmData, 1)
  
  If UBound(parmData, 2) > lngChunkSize Then
    ReDim DataForRange(1 To lngChunkSize, LBound(parmData, 1) To UBound(parmData, 1))
    For lngChunk = 1 To (UBound(parmData, 2) - (UBound(parmData, 2) Mod lngChunkSize)) Step lngChunkSize
      For lngLoop = 1 To lngChunkSize
        For lngCol = LBound(parmData, 1) To UBound(parmData, 1)
          DataForRange(lngLoop, lngCol) = sngData(lngCol, lngLoop + (lngChunk - 1))
        Next
      Next
      Set rngChunk = parmRange.Range(parmRange.Offset(lngChunk - 1, 0), parmRange.Offset(lngChunk - 1 + lngChunkSize, 1))
      rngChunk.Value = MSHFlexGrid1.TextMatrix
      
      lblStatus.Caption = "Now at Excel row " & lngChunk & " of " & UBound(parmData, 2) & " rows"
    Next
    
    'last little chunk
    ReDim DataForRange(1 To (UBound(parmData, 2) Mod lngChunkSize), LBound(parmData, 1) To UBound(parmData, 1)) 'UBound(sngData, 2) - 1)
    For lngLoop = 1 To (UBound(parmData, 2) Mod lngChunkSize)
      For lngCol = LBound(parmData, 1) To UBound(parmData, 1)
        DataForRange(lngLoop, lngCol) = sngData(lngCol, lngLoop + (lngChunk - 1))
      Next
    Next
    Set rngChunk = parmRange.Range(parmRange.Cells(lngChunk, 1), parmRange.Cells(lngChunk - 1 + (UBound(parmData, 2) Mod lngChunkSize), 2))
    rngChunk.Value = MSHFlexGrid1.TextMatrix
  
  Else
    
    'only little chunk
    lngChunk = 1
    ReDim DataForRange(1 To UBound(parmData, 2), LBound(parmData, 1) To UBound(parmData, 1))
    For lngLoop = 1 To (UBound(parmData, 2) Mod lngChunkSize)
      For lngCol = LBound(parmData, 1) To UBound(parmData, 1)
        DataForRange(lngLoop, lngCol) = sngData(lngCol, lngLoop + (lngChunk - 1))
      Next
    Next
    Set rngChunk = parmRange.Range(parmRange.Cells(lngChunk, 1), parmRange.Cells(lngChunk - 1 + UBound(parmData, 2), 2))
    rngChunk.Value = MSHFlexGrid1.TextMatrix
  
  End If
End Sub 

Select allOpen in new window

And the Export click command?

Private Sub cmdExport_Click()
  Dim xlObj As Object    'New Excel.Application -- only used with Excel reference
  Dim wkbOut As Object   'Excel.Workbook
  Dim wksOut As Object   'Excel.Worksheet
  Dim rngOut As Object   'Excel.Range
  Dim sngStart As Single	'forperformance measurement  

  'output to Excel workbook
  lblStatus.Caption = "Begin Excel Data Export"
  Set xlObj = CreateObject("Excel.Application")
  Set wkbOut = xlObj.Workbooks.Add
  Set wksOut = wkbOut.Worksheets("Sheet1")  'can skip this step
  Set rngOut = wksOut.Range("A1")           'by replacing with wkbOut.Worksheets("Sheet1").Range("A1")
  
  Me.MousePointer = vbHourglass
  Me.Enabled = False
  
  xlObj.ScreenUpdating = False
  xlObj.Calculation = -4135     '=xlCalculationManual

  sngStart = Timer
  BulkLoad rngOut, sngData
  
  lblStatus.Caption = "Finished Excel Data Export. (" & Timer - sngStart & " seconds)"

  xlObj.Calculation = -4105     '=xlCalculationAutomatic
  xlObj.ScreenUpdating = True
  xlObj.Visible = True
  
  Set rngOut = Nothing
  Set wksOut = Nothing
  Set wkbOut = Nothing
  Set xlObj = Nothing

  Me.MousePointer = vbDefault
  Me.Enabled = True

End Sub

Select allOpen in new window

Are you transferring the entire contents of the grid?

Was there something about my article that you did not understand?  Push all the data in one operation -- a single statement.  Do not loop.

What is your code trying to accomplish?

Yes,

all the grid columns and rows needs to be transferred in Excel.

I was trying to use your code to do it. I just have some problem to fully understand the full process.

You already have a 2D array in the TextMatrix.  Transfer that directly into your target range's value property.  Look at my earlier comment.

In other words, ignore the code you've written.  Don't think about your code.  Think about what I'm writing.  Do not iterate.  You should only need a single VB statement to do this.

Sorry but i may be confused.

Think about what I'm writing.  Do not iterate.

What is the only code i need to extract everything to excel?

something like this:

wksTgt.Range(rngTgt.Cells(1,1),rngTgt.Cells(gridname.textmatrix.rows.count,gridname.textmatrix.columns.count)).Value = gridname.textmatrix

Select allOpen in new window

you can also use the Offset property for the lower right end of the target range

rngTgt.Offset(gridname.textmatrix.rows.count,gridname.textmatrix.columns.count)

Select allOpen in new window

When i only use the code, i get a compile error argument not optional on: MSHFlexGrid1.TextMatrix

wksTgt.Range(rngTgt.Cells(1, 1), rngTgt.Cells(MSHFlexGrid1.TextMatrix.Rows.Count, MSHFlexGrid1.TextMatrix.Columns.Count)).Value = MSHFlexGrid1.TextMatrix

Select allOpen in new window

Did you read my comments in this thread, especially the ones accompanying these code snippets?

You need to define the size of the target range as the same size and shape as your grid data.  I used rows.count and columns.count as place holders.  You must know by now how big your grid is and how to get the rows count and columns count from the properties of the grid, or its properties' properties, or use VB functions like UBound().

When I wrote wksTgt, it is meant to represent the target worksheet.

How's your testing going?

wksTgt.Range(rngTgt.Cells(1,1),rngTgt.Cells(gridname.textmatrix.rows.count,gridname.textmatrix.columns.count)).Value = gridname.textmatrix

The problem here is that in VB6 Textmatrix refers to a single cell and it has no sub-properties. Also the number of columns is given by the Cols property and the number of rows by the Rows property and neither has any sub-properties.

Isn't TextMatrix a 2D array?

No, it's a single cell.

From MSDN

Visual Basic: MSFlexGrid/MSHFlexGrid Controls

Visual Studio 6.0

Returns or sets the text contents of an arbitrary cell.
Syntax
object.TextMatrix(rowindex, colindex) [=string]
The TextMatrix property syntax has these parts:
Part      Description
object      An object expression that evaluates to an object in the Applies To list.
rowindex, colindex      Integer. A numeric expression that specifies which cell to read or write.
string      A string expression containing the contents of an arbitrary cell.

Remarks
This property allows you to set or retrieve the contents of a cell without changing the Row and Col properties.

Can the TextArray property be used instead of TextMatrix?

I've never used TextArray but it is also just one cell.

Note that all that's necessary to copy/paste the grid's contents is lines 23 to 34 in my code. The rest is creating the excel objects.

I could swear I've done a bulk transfer without using the clipboard and without looping.  Problem with memory -- if you don't refresh it every so often it gets fuzzy.

Hi MartinLiss, aikimark

wow!! huge difference when pulling massive data with the code you provided MartinLiss compare to the one i was using before.  I will do some test and be back soon.

Thanks again for all the help

Thanks a lot.

Crazy how fast it is not to transfer massive data into excel.

You're welcome and I'm glad I was able to help.

In my profile you'll find links to some articles I've written that may interest you.
Marty - MVP 2009 to 2014

Looking back, I must have conflated the .Clip property of the flexgrid control with the clipboard.  It does return or set a chunk of flexgrid cells.