Solved

VB - Some problem when extractive data from MSHFlexgrid1 to excel

Posted on 2014-04-26
30
207 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
Comment Utility
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
Comment Utility
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
Comment Utility
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
 
LVL 11

Author Comment

by:Wilder1626
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
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
How your wiki can always stay up-to-date

Quip doubles as a “living” wiki and a project management tool that evolves with your organization. As you finish projects in Quip, the work remains, easily accessible to all team members, new and old.
- Increase transparency
- Onboard new hires faster
- Access from mobile/offline

 
LVL 11

Author Comment

by:Wilder1626
Comment Utility
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
Comment Utility
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
Comment Utility
How's your testing going?
0
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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 45

Accepted Solution

by:
Martin Liss earned 400 total points
Comment Utility
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
Comment Utility
Isn't TextMatrix a 2D array?
0
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
No, it's a single cell.
0
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
Comment Utility
Can the TextArray property be used instead of TextMatrix?
0
 
LVL 45

Expert Comment

by:Martin Liss
Comment Utility
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
Comment Utility
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
Comment Utility
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
Comment Utility
Thanks a lot.

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

Expert Comment

by:Martin Liss
Comment Utility
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
Comment Utility
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

Top 6 Sources for Identifying Threat Actor TTPs

Understanding your enemy is essential. These six sources will help you identify the most popular threat actor tactics, techniques, and procedures (TTPs).

Join & Write a Comment

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…
I was working on a PowerPoint add-in the other day and a client asked me "can you implement a feature which processes a chart when it's pasted into a slide from another deck?". It got me wondering how to hook into built-in ribbon events in Office.
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…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

771 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now