Start Free Trial

asked on

Transfer from Grid to excel

Hello all,

I need your help for a code that will first, sort all these column:
Column 0,3,4,6,7,8,9,10

Once done, it will export to excel, starting at row 7, going down, but i need to have 2 empty row between does that have different value in this Column 0,3,4,6,7,8,9,10.

Ex:see picture 1 for the grid and see picture 2 for the result in excel.

Thanks again for your help.

really appreciate.
transfer-in-excel.JPG
Result-excel.JPG

Here you have some starting points to transfer the data to excel

How to transfer data from an ADO Recordset to Excel with automation
http://support.microsoft.com/default.aspx?scid=kb;en-us;246335&Product=vb6

Datagrid to excel
https://www.experts-exchange.com/questions/21148107/DATAGRID-data-to-excel.html

When you export your datagrid, just add some empty rows between them, depending of your requirements

Just let me know if you still have some problems with parts of the code (this forum is not meant to write complete solutions).

ASKER

Hello all,

This is what i have for now but i can't put a 2 empty rows between the ones that are different.

Also the sorting is not perfect also. it does not combine all the same one together.

If Combo1.Text = "" Then
With Form29.MSHFlexGrid1
     .Col = 11
     .ColSel = 0
     .ColSel = 3
     .ColSel = 4
     .ColSel = 6
     .ColSel = 7
     .ColSel = 8
     .ColSel = 9
     .ColSel = 10
     .Sort = flexSortStringAscending
End With





     
    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 Form29.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
    
   xlObject.ActiveWorkbook.ActiveSheet.Range("a1") = Form29.Combo1.Text
    xlObject.ActiveWorkbook.ActiveSheet.Range("a1").Font.Bold = True
    xlObject.ActiveWorkbook.ActiveSheet.Range("a1").Font.Size = 17
    
    '205-197-191 = gris
    xlObject.ActiveWorkbook.ActiveSheet.Range("A6:p6").Interior.Color = RGB(205, 197, 191)
    
    xlObject.ActiveWorkbook.ActiveSheet.Range("a3") = "Date od this report:"
    xlObject.ActiveWorkbook.ActiveSheet.Range("a3").Font.Bold = True
    xlObject.ActiveWorkbook.ActiveSheet.Range("B3") = Format(Date, "mmm dd, yyyy")
    xlObject.ActiveWorkbook.ActiveSheet.Range("b3").Font.Bold = True

    
    
'.BorderAround Weight:=xlThin
    
    
       xlObject.ActiveWorkbook.ActiveSheet.Columns("A:A").ColumnWidth = 20
       xlObject.ActiveWorkbook.ActiveSheet.Columns("A:A").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("A:A").NumberFormat = "@"
       xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").ColumnWidth = 13
       xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").NumberFormat = "@"
       xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 44
       
       xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("D:D").ColumnWidth = 13
       xlObject.ActiveWorkbook.ActiveSheet.Columns("D:D").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 26
       xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 44
       
        xlObject.ActiveWorkbook.ActiveSheet.Columns("E:E").ColumnWidth = 13
       xlObject.ActiveWorkbook.ActiveSheet.Columns("E:E").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("F:F").ColumnWidth = 10
       xlObject.ActiveWorkbook.ActiveSheet.Columns("F:F").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("G:G").ColumnWidth = 15
       xlObject.ActiveWorkbook.ActiveSheet.Columns("G:G").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("H:H").ColumnWidth = 13
       xlObject.ActiveWorkbook.ActiveSheet.Columns("H:H").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("I:I").ColumnWidth = 17
       xlObject.ActiveWorkbook.ActiveSheet.Columns("I:I").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("J:J").ColumnWidth = 10
       xlObject.ActiveWorkbook.ActiveSheet.Columns("J:J").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("K:K").ColumnWidth = 10
       xlObject.ActiveWorkbook.ActiveSheet.Columns("K:K").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("L:L").ColumnWidth = 22
       xlObject.ActiveWorkbook.ActiveSheet.Columns("L:L").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("M:M").ColumnWidth = 40
       xlObject.ActiveWorkbook.ActiveSheet.Columns("M:M").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("N:N").ColumnWidth = 20
       xlObject.ActiveWorkbook.ActiveSheet.Columns("N:N").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("O:O").ColumnWidth = 24
       xlObject.ActiveWorkbook.ActiveSheet.Columns("O:O").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("P:P").ColumnWidth = 0
       xlObject.ActiveWorkbook.ActiveSheet.Columns("P:P").HorizontalAlignment = xlLeft
       
       
       
       
       xlObject.ActiveWorkbook.ActiveSheet.Range("a3") = "Date od this report:"
    xlObject.ActiveWorkbook.ActiveSheet.Range("a3").Font.Bold = True
    xlObject.ActiveWorkbook.ActiveSheet.Range("B3") = Format(Date, "mmm dd, yyyy")
    xlObject.ActiveWorkbook.ActiveSheet.Range("b3").Font.Bold = True


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


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


xlObject.ActiveWindow.FreezePanes = True

xlObject.ActiveWorkbook.ActiveSheet.Name = xlObject.ActiveWorkbook.ActiveSheet.Range("A1").Text & " " & xlObject.ActiveWorkbook.ActiveSheet.Range("b3").Text




xlObject.ActiveWorkbook.ActiveSheet.Range("A6").Select
  End With
       

     'MsgBox "Fichier Excel complété"
         ' This makes Excel visible
    xlObject.Visible = True
    
    
 End If
 Unload Me

Open in new window

The MSFlexGrid is sorting data in multiple columns by sorting the columns from left to right and always in the same order (descending/ascending). So you could swap the columns "occurence" and "operation" to achieve your goal.

Or what you can also do is to perform the sorting on database, when you retrieve the data .

ASKER

What do you mean by: swap the columns "occurence" and "operation"

Sorry, was a mistake. I mean with this just the columnnames, in your case you need to switch all the colums so that
0,3,4,6,7,8,9,10

will be 0,1,2,3,...

ASKER

so you are saying that if i go for the grid sort column, it will sort all columns and not just a few of them?

Is that correct?

ASKER

I'm also trying this now but i have an error on this part of the code when transferring to an excel sheet:

Error 3704
Operation is not allowed when the object is closed

  xlWs.Cells(2, 1).CopyFromRecordset rst

Open in new window

Full code

 Dim cnt As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    
    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object

    
    Dim recArray As Variant
    
    Dim strDB As String
    Dim fldCount As Integer
    Dim recCount As Long
    Dim iCol As Integer
    Dim iRow As Integer
    
    ' Set the string to the path of your Northwind database
    strDB = "C:\Documents and Settings\daniel\Desktop\Text Xdock.xlsx"
  
       
    ' Create an instance of Excel and add a workbook
    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Feuil1")
  
    ' Display Excel and give user control of Excel's lifetime
    xlApp.Visible = True
    xlApp.UserControl = True
    
    ' Copy field names to the first row of the worksheet
    fldCount = rst.Fields.Count
    For iCol = 1 To fldCount
        xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
    Next
        
    ' Check version of Excel
    If val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
        'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset
         
        ' Copy the recordset to the worksheet, starting in cell A2
        
        xlWs.Cells(2, 1).CopyFromRecordset rst
        'Note: CopyFromRecordset will fail if the recordset
        'contains an OLE object field or array data such
        'as hierarchical recordsets
        
    Else
        'EXCEL 97 or earlier: Use GetRows then copy array to Excel
    
        ' Copy recordset to an array
        recArray = rst.GetRows
        'Note: GetRows returns a 0-based array where the first
        'dimension contains fields and the second dimension
        'contains records. We will transpose this array so that
        'the first dimension contains records, allowing the
        'data to appears properly when copied to Excel
        
        ' Determine number of records

        recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array
        

        ' Check the array for contents that are not valid when
        ' copying the array to an Excel worksheet
        For iCol = 0 To fldCount - 1
            For iRow = 0 To recCount - 1
                ' Take care of Date fields
                If IsDate(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = Format(recArray(iCol, iRow))
                ' Take care of OLE object fields or array fields
                ElseIf IsArray(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = "Array Field"
                End If
            Next iRow 'next record
        Next iCol 'next field
            
        ' Transpose and Copy the array to the worksheet,
        ' starting in cell A2
        xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
            TransposeDim(recArray)
    End If

    ' Auto-fit the column widths and row heights
    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit

    ' Close ADO objects
    rst.Close
    cnt.Close
    Set rst = Nothing
    Set cnt = Nothing
    
    ' Release Excel references
    Set xlWs = Nothing
    Set xlWb = Nothing

    Set xlApp = Nothing

Open in new window

But I'm afraid that you can't use the CopyFromRecordset if you want to add empty spaces in your excel.

You'll need to loop over your mshflexgrid

Something like

dim rowNumber as integer
rowNumber = 7

With MSHFlexGrid1
For DataIdx = 1 To MSHFlexGrid1.Rows - 1
' move data from column to excel
rownumber = rownumber + 1
xlWs.Cells(rownumber , 1).Text = .TextMatrix(DataIdx, 0)
xlWs.Cells(rownumber , 2).Text = .TextMatrix(DataIdx, 1)

' if the key is different, add 1 to the rownumber to add an empty row
if .... then rownumber = rownumber + 1 end if
Next
End With

ASKER

Ok, i have try this now but i have an error 424
An object is required.

With Form29.MSHFlexGrid1
For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
' move data from column to excel
rowNumber = rowNumber + 1
xlWs.Cells(rowNumber, 1).Text = .TextMatrix(DataIdx, 0)
xlWs.Cells(rowNumber, 2).Text = .TextMatrix(DataIdx, 1)

Next
End With

I'm sort of lost in this process.

Full code

 Dim cnt As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    
    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object

    
    Dim recArray As Variant
    
    Dim strDB As String
    Dim fldCount As Integer
    Dim recCount As Long
    Dim iCol As Integer
    Dim iRow As Integer
    
    ' Set the string to the path of your Northwind database
    strDB = "C:\Documents and Settings\jpoitra\Desktop\Text Xdock.xlsx"
  
       
    ' Create an instance of Excel and add a workbook
    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Feuil1")
  
    ' Display Excel and give user control of Excel's lifetime
    xlApp.Visible = True
    xlApp.UserControl = True
    
    ' Copy field names to the first row of the worksheet
    fldCount = rst.Fields.Count
    For iCol = 1 To fldCount
        xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
    Next
        
    ' Check version of Excel
    If val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
        'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset
         
        ' Copy the recordset to the worksheet, starting in cell A2
        Dim rowNumber As Integer
        Dim DataIdx As Integer
rowNumber = 7

   With Form29.MSHFlexGrid1
      For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
          ' move data from column to excel
         rowNumber = rowNumber + 1
          xlWs.Cells(rowNumber, 1).Text = .TextMatrix(DataIdx, 0)
          xlWs.Cells(rowNumber, 2).Text = .TextMatrix(DataIdx, 1)

        
      Next
   End With
        'Note: CopyFromRecordset will fail if the recordset
        'contains an OLE object field or array data such
        'as hierarchical recordsets
        
    Else
        'EXCEL 97 or earlier: Use GetRows then copy array to Excel
    
        ' Copy recordset to an array
        recArray = rst.GetRows
        'Note: GetRows returns a 0-based array where the first
        'dimension contains fields and the second dimension
        'contains records. We will transpose this array so that
        'the first dimension contains records, allowing the
        'data to appears properly when copied to Excel
        
        ' Determine number of records

        recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array
        

        ' Check the array for contents that are not valid when
        ' copying the array to an Excel worksheet
        For iCol = 0 To fldCount - 1
            For iRow = 0 To recCount - 1
                ' Take care of Date fields
                If IsDate(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = Format(recArray(iCol, iRow))
                ' Take care of OLE object fields or array fields
                ElseIf IsArray(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = "Array Field"
                End If
            Next iRow 'next record
        Next iCol 'next field
            
        ' Transpose and Copy the array to the worksheet,
        ' starting in cell A2
        xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
            TransposeDim(recArray)
    End If

    ' Auto-fit the column widths and row heights
    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit

    ' Close ADO objects
    rst.Close
    cnt.Close
    Set rst = Nothing
    Set cnt = Nothing
    
    ' Release Excel references
    Set xlWs = Nothing
    Set xlWb = Nothing

    Set xlApp = Nothing

Open in new window

ASKER

Now i also have error 1004

Impossible to define Text in the class range.On the same line code

Try this

With Form29.MSHFlexGrid1
For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
' move data from column to excel
rowNumber = rowNumber + 1
xlWs.Cells(rowNumber, 1)= .TextMatrix(DataIdx, 0)
xlWs.Cells(rowNumber, 2)= .TextMatrix(DataIdx, 1)

Next
End With

ASKER

Perfect

The transfer part work know. see attachment.

I just need to be able to put sort the data and then add spaces in between.

 Dim cnt As New ADODB.Connection
    Dim rst As New ADODB.Recordset
    
    Dim xlApp As Object
    Dim xlWb As Object
    Dim xlWs As Object

    
    Dim recArray As Variant
    
    Dim strDB As String
    Dim fldCount As Integer
    Dim recCount As Long
    Dim iCol As Integer
    Dim iRow As Integer
    
    ' Set the string to the path of your Northwind database
    strDB = "C:\Documents and Settings\jpoitra\Desktop\Text Xdock.xlsx"
  
       
    ' Create an instance of Excel and add a workbook
    Set xlApp = CreateObject("Excel.Application")
    Set xlWb = xlApp.Workbooks.Add
    Set xlWs = xlWb.Worksheets("Feuil1")
  
    ' Display Excel and give user control of Excel's lifetime
    xlApp.Visible = True
    xlApp.UserControl = True
    
    ' Copy field names to the first row of the worksheet
    fldCount = rst.Fields.Count
    For iCol = 1 To fldCount
        xlWs.Cells(1, iCol).Value = rst.Fields(iCol - 1).Name
    Next
        
    ' Check version of Excel
    If val(Mid(xlApp.Version, 1, InStr(1, xlApp.Version, ".") - 1)) > 8 Then
        'EXCEL 2000,2002,2003, or 2007: Use CopyFromRecordset
         
        ' Copy the recordset to the worksheet, starting in cell A2
        Dim rowNumber As Integer
        Dim DataIdx As Integer
rowNumber = 7

   With Form29.MSHFlexGrid1
      For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
          ' move data from column to excel
         rowNumber = rowNumber + 1
          xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
          xlWs.Cells(rowNumber, 2) = .TextMatrix(DataIdx, 1)
          xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 2)
           xlWs.Cells(rowNumber, 4) = .TextMatrix(DataIdx, 3)
            xlWs.Cells(rowNumber, 5) = .TextMatrix(DataIdx, 4)
             'xlWs.Cells(rowNumber, 6) = .TextMatrix(DataIdx, 5)
              xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 6)
               xlWs.Cells(rowNumber, 8) = .TextMatrix(DataIdx, 7)
                xlWs.Cells(rowNumber, 9) = .TextMatrix(DataIdx, 8)
                 xlWs.Cells(rowNumber, 10) = .TextMatrix(DataIdx, 9)
                  xlWs.Cells(rowNumber, 11) = .TextMatrix(DataIdx, 10)
                   xlWs.Cells(rowNumber, 12) = .TextMatrix(DataIdx, 11)
                    xlWs.Cells(rowNumber, 13) = .TextMatrix(DataIdx, 12)
                     xlWs.Cells(rowNumber, 14) = .TextMatrix(DataIdx, 13)
                      xlWs.Cells(rowNumber, 15) = .TextMatrix(DataIdx, 14)

        
      Next
   End With
        'Note: CopyFromRecordset will fail if the recordset
        'contains an OLE object field or array data such
        'as hierarchical recordsets
        
    Else
        'EXCEL 97 or earlier: Use GetRows then copy array to Excel
    
        ' Copy recordset to an array
        recArray = rst.GetRows
        'Note: GetRows returns a 0-based array where the first
        'dimension contains fields and the second dimension
        'contains records. We will transpose this array so that
        'the first dimension contains records, allowing the
        'data to appears properly when copied to Excel
        
        ' Determine number of records

        recCount = UBound(recArray, 2) + 1 '+ 1 since 0-based array
        

        ' Check the array for contents that are not valid when
        ' copying the array to an Excel worksheet
        For iCol = 0 To fldCount - 1
            For iRow = 0 To recCount - 1
                ' Take care of Date fields
                If IsDate(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = Format(recArray(iCol, iRow))
                ' Take care of OLE object fields or array fields
                ElseIf IsArray(recArray(iCol, iRow)) Then
                    recArray(iCol, iRow) = "Array Field"
                End If
            Next iRow 'next record
        Next iCol 'next field
            
        ' Transpose and Copy the array to the worksheet,
        ' starting in cell A2
        xlWs.Cells(2, 1).Resize(recCount, fldCount).Value = _
            TransposeDim(recArray)
    End If

    ' Auto-fit the column widths and row heights
    xlApp.Selection.CurrentRegion.Columns.AutoFit
    xlApp.Selection.CurrentRegion.Rows.AutoFit

    ' Close ADO objects
    
    On Error Resume Next
    rst.Close
    cnt.Close
    Set rst = Nothing
    Set cnt = Nothing
    
    ' Release Excel references
    Set xlWs = Nothing
    Set xlWb = Nothing

    Set xlApp = Nothing

Open in new window

Export-result.xlsx

You can do the spacing with something like this: (I just used only 2 key-columns)

dim sKey as string
sKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) +
"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)

With Form29.MSHFlexGrid1
For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
dim newKey as string
newKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)
if newKey <> sKey then
rowNumber = rowNumber + 2
newKey = sKey
end if
' move data from column to excel
rowNumber = rowNumber + 1
xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
...

Next

ASKER

So if i understand right, i should put that code:

  dim sKey as string
  sKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) +
"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)

  With Form29.MSHFlexGrid1
      For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
         dim newKey as string
         newKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)
         if newKey <> sKey then
            rowNumber = rowNumber + 2
            newKey = sKey
         end if
          ' move data from column to excel
         rowNumber = rowNumber + 1
          xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)

      Next

Open in new window

Just before:

 With Form29.MSHFlexGrid1
      For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
          ' move data from column to excel
         rowNumber = rowNumber + 1
          xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
          xlWs.Cells(rowNumber, 2) = .TextMatrix(DataIdx, 1)
          xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 2)
           xlWs.Cells(rowNumber, 4) = .TextMatrix(DataIdx, 3)
            xlWs.Cells(rowNumber, 5) = .TextMatrix(DataIdx, 4)
             'xlWs.Cells(rowNumber, 6) = .TextMatrix(DataIdx, 5)
              xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 6)
               xlWs.Cells(rowNumber, 8) = .TextMatrix(DataIdx, 7)
                xlWs.Cells(rowNumber, 9) = .TextMatrix(DataIdx, 8)
                 xlWs.Cells(rowNumber, 10) = .TextMatrix(DataIdx, 9)
                  xlWs.Cells(rowNumber, 11) = .TextMatrix(DataIdx, 10)
                   xlWs.Cells(rowNumber, 12) = .TextMatrix(DataIdx, 11)
                    xlWs.Cells(rowNumber, 13) = .TextMatrix(DataIdx, 12)
                     xlWs.Cells(rowNumber, 14) = .TextMatrix(DataIdx, 13)
                      xlWs.Cells(rowNumber, 15) = .TextMatrix(DataIdx, 14)

        
      Next
   End With

Open in new window

Once you get the FlexGrid looking and formatted the way you want, refer back to my previous help to you on geting a FlexGrid to Excel:

https://www.experts-exchange.com/questions/26269799/Transfer-VB-MsFlexgrid1-to-an-existing-excel-spreadsheet.html

I just removed some columns to show what you can do ...

dim sKey as string
  sKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) +
"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)

  With Form29.MSHFlexGrid1
      For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
         dim newKey as string
         newKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)
         if newKey <> sKey then
            rowNumber = rowNumber + 2
            newKey = sKey
         end if
          ' move data from column to excel
         rowNumber = rowNumber + 1

          ' move data from column to excel
         rowNumber = rowNumber + 1
          xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
          xlWs.Cells(rowNumber, 2) = .TextMatrix(DataIdx, 1)
          xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 2)
           xlWs.Cells(rowNumber, 4) = .TextMatrix(DataIdx, 3)
            xlWs.Cells(rowNumber, 5) = .TextMatrix(DataIdx, 4)
             'xlWs.Cells(rowNumber, 6) = .TextMatrix(DataIdx, 5)
              xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 6)
               xlWs.Cells(rowNumber, 8) = .TextMatrix(DataIdx, 7)
                xlWs.Cells(rowNumber, 9) = .TextMatrix(DataIdx, 8)
                 xlWs.Cells(rowNumber, 10) = .TextMatrix(DataIdx, 9)
                  xlWs.Cells(rowNumber, 11) = .TextMatrix(DataIdx, 10)
                   xlWs.Cells(rowNumber, 12) = .TextMatrix(DataIdx, 11)
                    xlWs.Cells(rowNumber, 13) = .TextMatrix(DataIdx, 12)
                     xlWs.Cells(rowNumber, 14) = .TextMatrix(DataIdx, 13

      Next

Open in new window

ASKER

Hello Dhaest

I was able to make the code work but now, it does not respect the sort criteria

Now it put 2 empty lane between every row with data.

It does not look like the excel sheet that i sent has an example in my first post.

ASKER

I also see that it does not sort it properly on these columns
.Col = 11
.ColSel = 0
.ColSel = 3
.ColSel = 4
.ColSel = 6
.ColSel = 7
.ColSel = 8
.ColSel = 9
.ColSel = 10

For the sorting I see 2 possibilities:

1. From where do you retrieve your data ? Is it coming from a database ? If so, add the sorting there.

2. The MSFlexGrid is sorting data in multiple columns by sorting the columns from left to right and always in the same order (descending/ascending). So try to put the columns in the order that you want them to be sorted.

Sorting on a FlexGrid in VB6 is frustrating, because of the language/FlexGrid's limitations. Microsoft COULD have made sorting work properly, but they didn't. Here are the two factors that make sorting difficult:

1. If sorting multiple columns, they must be contiguous (no gaps). You can set the .Col and .ColSel properties to select a range of columns to sort, then use the .Sort method. Sorting always occurs from left to right, even if .ColSel < .Col.

2. You might think, "Hey, I need to sort by column 0, 4, and 6 (in that order). Since multi-column sorts must have the columns contiguous, I'll just do three single sorts. I'll sort on column 0 first, then sort again on column 4, then lastly on column 6". Forget it. If you try this, you'll find out very quickly that subsequent sorts destroy the results of the previous sort. In this example, after you sort on column 0, the sort on column 4 will sort ONLY by what's in column 4 and disregard anything in column 0, including the previous sort.

ASKER

ok, so i think the best why is to sort it from the excel sheet directly.

That's ok for me.

So the only thing that i need now is to be able to transfer from the master excel sheet to a new excel sheet in a specific format where it will put 2 empty lines after each different value from excel column in picture bellow.

First column being column A.

Do i keep the same code?

dim sKey as string
  sKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) +
"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)

  With Form29.MSHFlexGrid1
      For DataIdx = 1 To Form29.MSHFlexGrid1.Rows - 1
         dim newKey as string
         newKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3)
         if newKey <> sKey then
            rowNumber = rowNumber + 2
            newKey = sKey
         end if
          ' move data from column to excel
         rowNumber = rowNumber + 1

          ' move data from column to excel
         rowNumber = rowNumber + 1
          xlWs.Cells(rowNumber, 1) = .TextMatrix(DataIdx, 0)
          xlWs.Cells(rowNumber, 2) = .TextMatrix(DataIdx, 1)
          xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 2)
           xlWs.Cells(rowNumber, 4) = .TextMatrix(DataIdx, 3)
            xlWs.Cells(rowNumber, 5) = .TextMatrix(DataIdx, 4)
             'xlWs.Cells(rowNumber, 6) = .TextMatrix(DataIdx, 5)
              xlWs.Cells(rowNumber, 3) = .TextMatrix(DataIdx, 6)
               xlWs.Cells(rowNumber, 8) = .TextMatrix(DataIdx, 7)
                xlWs.Cells(rowNumber, 9) = .TextMatrix(DataIdx, 8)
                 xlWs.Cells(rowNumber, 10) = .TextMatrix(DataIdx, 9)
                  xlWs.Cells(rowNumber, 11) = .TextMatrix(DataIdx, 10)
                   xlWs.Cells(rowNumber, 12) = .TextMatrix(DataIdx, 11)
                    xlWs.Cells(rowNumber, 13) = .TextMatrix(DataIdx, 12)
                     xlWs.Cells(rowNumber, 14) = .TextMatrix(DataIdx, 13

Open in new window

ASKER

oups, here is the picture

sorting-column.JPG

For the ordering: Can you first tell where exactly you get the data the first time (when you load everything into the mshflexgrid) !

ASKER

it come's from a master excel spreadsheet on the network.

Do you need the code i'm using for importing it in the grid?

Yes please. Because when you are retrieving it through a query or so, perhaps we can perform the sorting at that moment

ASKER

ok,

This is the code i use:

Dim xlObject     As Excel.Application
Dim xlWb         As Excel.Workbook
Dim NoOfRows     As Long
Dim NoOfColumns  As Long
Dim i            As Single
Dim j            As Single
Dim Frmula       As String
Dim C1           As String
Dim C2           As String
Dim C3           As String
Dim C4           As String

    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)
            FetchNoRowCol xlObject.ActiveWorkbook.ActiveSheet, NoOfRows, NoOfColumns
            C1 = 7 - (NoOfColumns + 1)
            C2 = 6 - (NoOfColumns + 1)
            C3 = 4 - (NoOfColumns + 1)
            C4 = 0 - (NoOfColumns + 1)
            
            Frmula = "=IF(RC[" & C1 & "]=R[-1]C[" & C1 & "],IF(RC[" & C2 & "]=R[-1]C[" & C2 & "],IF(RC[" & C3 & "]=R[-1]C[" & C3 & "],IF(RC[" & C4 & "]=R[-1]C[" & C4 & "],1,0),0),0),0)"
            
            For i = 2 To NoOfRows
               xlWb.Worksheets(1).Cells(i, NoOfColumns + 1).FormulaR1C1 = Frmula
            Next i
            
            Clipboard.Clear
            xlObject.Cells.Copy     ' Copy all cells in active worksheet.
            
            With MSHFlexGrid1
               .Redraw = False     'Dont draw until the end, so we avoid that flash
               .Rows = NoOfRows
               .Cols = NoOfColumns + 1
               .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
               .Col = NoOfColumns
               .ColWidth(NoOfColumns) = 0
               For i = 2 To NoOfRows - 1
                  .Col = NoOfColumns
                  .Row = i
                  If .Text = 1 Then
                     For j = 1 To NoOfColumns
                        .Col = j
                        .Row = i
                        .CellBackColor = vb3DLight
                     Next
                  End If
               Next
               .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
    
    'Auto column fit
    Dim r As Long
Dim C As Long
Dim cell_wid As Single
Dim col_wid As Single

    For C = 0 To MSHFlexGrid1.Cols - 1
        col_wid = 0
        For r = 0 To MSHFlexGrid1.Rows - 1
            cell_wid = TextWidth(MSHFlexGrid1.TextMatrix(r, C))
            If col_wid < cell_wid Then col_wid = cell_wid
        Next r
        MSHFlexGrid1.ColWidth(C) = col_wid + 120
    Next C
    
    
   'MSHFlexGrid1.ColAlignment(2) = flexAlignLeftCenter
    
    
    
    Dim z As Long, txt As String, total As Long
For z = 1 To MSHFlexGrid1.Rows - 1
  If Len(MSHFlexGrid1.TextMatrix(z, 3)) Then total = total + 1
  
  


Next z
lblTotalrecord = CStr(total)

'Command3.Enabled = False
If lblTotalrecord > "" Then
Command3.Enabled = True
Else
Command3.Enabled = False
End If


'Command1.Enabled = False
If lblTotalrecord > "" And lblTotalrecord1 > "" Then
Command1.Enabled = True
Else
Command1.Enabled = False
End If

MSHFlexGrid1.CellAlignment = 0


Dim k As Long

For k = 1 To MSHFlexGrid1.Rows - 1

If MSHFlexGrid1.TextMatrix(k, 1) <> "" Then
   MSHFlexGrid1.TextMatrix(k, 5) = MSHFlexGrid1.TextMatrix(k, 0) & MSHFlexGrid1.TextMatrix(k, 1) & MSHFlexGrid1.TextMatrix(k, 6)

  End If

Next k




   
    Exit Sub

MyErrHandler:
    Err.Clear

Open in new window

I think Dhaest is on the right track. If you can get the FlexGrid looking just like the Excel sheet should (hopefully even including the two blank rows between sorts), then transferring from the grid to the sheet will be a snap.

ASKER

ok so i really need to do all the manual change in the original file first. Is that right?

Sort them first and then put an empty space between them.

The problem is that some time, i may have like 14 000 rows. I wanted to find an easy why of doing it.

ASKER

I was doing some test and i think that i'm almost there.

I have manually sorted the excel sheet the way i wanted.

Now, i have a code added to the first one:

Sub AddTotal1(sh As Worksheet)
Dim Time As String
Dim Amt As Double
Dim Amt1 As Double
Dim Amt2 As Double
Dim Amt3 As Double
Dim Amt4 As Double
Dim Amt5 As Double
Dim Amt6 As Double
Dim Amt7 As Double
Dim Amt8 As Double
Dim Counter As String
On Error Resume Next
Counter = 7

With sh
sh.Activate
Do

    Time = .Cells(Counter, 10).Value
    Do
        Amt = Amt + .Cells(Counter, 1)
        Amt1 = Amt1 + .Cells(Counter, 4)
        Amt2 = Amt1 + .Cells(Counter, 5)
        Amt3 = Amt1 + .Cells(Counter, 6)
        Amt4 = Amt1 + .Cells(Counter, 7)
        Amt5 = Amt1 + .Cells(Counter, 8)
        Amt6 = Amt1 + .Cells(Counter, 9)
        Amt7 = Amt1 + .Cells(Counter, 10)
        Amt8 = Amt1 + .Cells(Counter, 11)
        Counter = Counter + 1

        
    Loop Until Time <> .Cells(Counter, 10)
    
    'Insert Total
    .Cells(Counter, 1).EntireRow.Insert
    .Cells(Counter, 2) = "Total"
    .Cells(Counter, 2).Font.Bold = True
    .Cells(Counter, 3) = Amt
    .Cells(Counter, 3).Font.Bold = True
    .Cells(RowNum, 4) = Amt1
    .Cells(Counter, 4).Font.Bold = True
    .Cells(Counter + 1, 1).EntireRow.Insert
    
    Counter = Counter + 2
    Amt = 0
    Amt1 = 0
    Amt2 = 0
    Amt3 = 0
    Amt4 = 0
    Amt5 = 0
    Amt6 = 0
    Amt7 = 0
    Amt8 = 0
    
           
Loop Until .Cells(Counter, 10) = ""
End With
End Sub

Open in new window

I'm adding this code the my other code:

AddTotal1 xlObject.ActiveWorkbook.ActiveSheet

Open in new window

Now it kind of separate with a 2 row in between but not at 100% what i need.

It really have to conceder all these column:
1-4-5-6-7-8-9-10-11.

can you help me with it please?

Thanks again

ASKER

Would it be concatenated column 1-4-5-6-7-8-9-10-11 and then the value in the grid in cell 15 and then, be able to sort it by value in cell 15?

>> Would it be concatenated column 1-4-5-6-7-8-9-10-11 and then the value in the grid in cell 15 and then, be able to sort it by value in cell 15?

You can do that and use that as key or make the complete key correctly (all the fields you need)

newKey = Form29.MSHFlexGrid1.TextMatrix(DataIdx, 0) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 1) + "|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 2) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 3) +"|" + Form29.MSHFlexGrid1.TextMatrix(DataIdx, 4) + ...

ASKER

Perfect

That that this is done, how can i transfer it the excel with 2 empty row between all different value in cell 15 where i now have the concatenation?

ASKER CERTIFIED SOLUTION

membership

This solution is only available to members.

To access this solution, you must be a member of Experts Exchange.

Start Free Trial

ASKER

yes but it don't add empty row between different value in column O in the excel sheet right?

That's the only things left to do now.

After that, i will be able to manage all other things.

Now the question is, to separate them, will i have to do it manually or it can be done with VB6?

Can you post an example of all the values in your msflexgrid (including the new column with the key) and also a better overview of when exactly you need an empty row ...

ASKER

ok, let me do this and i will come back with 2 examples.

Thanks again for your time and help

As DHaest has said before, with a highly-populated Excel sheet, it might take a while, but it can be done in VB6 if need be. Just maintain a variable in the local routine that transfers records from Excel to the grid, and set it to what's in column 0 with each pull from Excel. When the newly-pulled record doesn't equal the variable, add your empty rows to the grid, and change the variable to the new value.

ASKER

OK, this excel file has 2 sheet.

The before and after result.

Please let me know if this could be done by VB6.

Thanks again.
Copie-de-Text-Xdock.xlsx

I think that I gave enough code-tips & trics to get to the final solution. See comment #35146518 and #35155638

ASKER

Please do not cancel

ASKER

Hello

Thanks. I will work with that answer.

Thanks again and sorry for the delay