Solved

VB - Some problem when extractive data from MSHFlexgrid1 to excel

Posted on 2014-04-26
30
210 Views
Last Modified: 2014-04-30
Hi

I have the below code that extract data from my MSHFlexgrid1 to excel.

Dim xlObject    As Excel.Application
Dim xlWB        As Excel.Workbook
     
    Set xlObject = New Excel.Application


    'This Adds a new woorkbook, you could open the workbook from file also
    Set xlWB = xlObject.Workbooks.Add
               
    Clipboard.clear 'Clear the Clipboard
    With MSHFlexGrid1
        'Select Full Contents (You could also select partial content)
        .Col = 0               'From first column
        .Row = 0               'From first Row (header)
        .ColSel = .Cols - 1    'Select all columns
        .RowSel = .Rows - 1    'Select all rows
        Clipboard.SetText .Clip 'Send to Clipboard

    End With
           
    With xlObject.ActiveWorkbook.ActiveSheet
    
    
        .Range("A6").Select 'Select Cell A1 (will paste from here, to different cells)
        .Paste   'Paste clipboard content


xlObject.ActiveWorkbook.ActiveSheet.Range("B7").Select

xlObject.ActiveWorkbook.ActiveSheet.Columns("B:AD").AutoFit
xlObject.ActiveWindow.FreezePanes = True  

Open in new window


The problem i have is that some rows don't stay aligned.

Ex: on a row, once at column 7 that normally should be past in Excel in column G, turns to be on row below and in column A.

When i look in the access dbase see if i have sort of an empty space or a tab, i don't see any..

In below picture, what's in green, should be in the yellow fields cause in the grid, they are on the same row.

grid to excel
would you know how i can fix this, to export each row from my MSHFlexgrid1 to respect each row in Excel?

Thanks
0
Comment
Question by:Wilder1626
  • 14
  • 10
  • 6
30 Comments
 
LVL 11

Author Comment

by:Wilder1626
ID: 40025738
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

Open 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

Open in new window

0
 
LVL 45

Assisted Solution

by:aikimark
aikimark earned 100 total points
ID: 40025761
You can directly assign the values of a worksheet range from an array.  I would suggest you look at my Fast Data Push To Excel article for an explanation and details: http:A_2253.html

This is preferable to using the clipboard to transfer data.
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 40025776
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
0
Courses: Start Training Online With Pros, Today

Brush up on the basics or master the advanced techniques required to earn essential industry certifications, with Courses. Enroll in a course and start learning today. Training topics range from Android App Dev to the Xen Virtualization Platform.

 
LVL 11

Author Comment

by:Wilder1626
ID: 40025798
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

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 40025849
You directly assign the value property of a range to the textmatrix array.
Example:
rngChunk.Value = gridname.textmatrix

Open 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

Open 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.
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 40025863
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

Open 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

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 40025910
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.
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 40026027
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 

Open 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

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 40026053
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?
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 40026058
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.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40026065
You already have a 2D array in the TextMatrix.  Transfer that directly into your target range's value property.  Look at my earlier comment.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40026069
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.
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 40026151
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?
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40026162
something like this:
wksTgt.Range(rngTgt.Cells(1,1),rngTgt.Cells(gridname.textmatrix.rows.count,gridname.textmatrix.columns.count)).Value = gridname.textmatrix

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 40026168
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)

Open in new window

0
 
LVL 11

Author Comment

by:Wilder1626
ID: 40026177
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

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 40026201
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.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40028165
How's your testing going?
0
 
LVL 46

Expert Comment

by:Martin Liss
ID: 40028441
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.
0
 
LVL 46

Accepted Solution

by:
Martin Liss earned 400 total points
ID: 40028538
You don't need the code you posted in post ID 40025863. Just change your cmdExport code to this which will put the data asa block whose upper left-hand corner is A1.

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
  Clipboard.Clear 'Clear the Clipboard
    With MSFlexGrid1
        .Col = 0
        .Row = 0
        .ColSel = .Cols - 1
        .RowSel = .Rows - 1
        Clipboard.SetText .Clip
    End With
     With xlObj.ActiveWorkbook.ActiveSheet
        .Range("A1").Select
        .Paste
    End With
  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

Open in new window

0
 
LVL 45

Expert Comment

by:aikimark
ID: 40028591
Isn't TextMatrix a 2D array?
0
 
LVL 46

Expert Comment

by:Martin Liss
ID: 40028597
No, it's a single cell.
0
 
LVL 46

Expert Comment

by:Martin Liss
ID: 40028598
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.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40028622
Can the TextArray property be used instead of TextMatrix?
0
 
LVL 46

Expert Comment

by:Martin Liss
ID: 40028633
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.
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40028640
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.
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 40029315
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
0
 
LVL 11

Author Closing Comment

by:Wilder1626
ID: 40032152
Thanks a lot.

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

Expert Comment

by:Martin Liss
ID: 40032405
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
0
 
LVL 45

Expert Comment

by:aikimark
ID: 40032534
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.
0

Featured Post

Live: Real-Time Solutions, Start Here

Receive instant 1:1 support from technology experts, using our real-time conversation and whiteboard interface. Your first 5 minutes are always free.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Background What I'm presenting in this article is the result of 2 conditions in my work area: We have a SQL Server production environment but no development or test environment; andWe have an MS Access front end using tables in SQL Server but we a…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

785 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question