Transfer to excel in VB6

Hello all

I need your help on this code.

This code transfer all my grid to excel.

But i just want to transfer  
If .TextMatrix(i, 14) = "NEEDS TO BE REMOVED" Then

Open in new window


*********** Full Code *************

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 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") = "Remove from preprocessor"
    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 of 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 = 14
       
       xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("D:D").ColumnWidth = 16
       xlObject.ActiveWorkbook.ActiveSheet.Columns("D:D").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 14
       xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 14
       
        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("G:G").NumberFormat = "@"
        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 = 22
        xlObject.ActiveWorkbook.ActiveSheet.Columns("J:J").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("K:K").ColumnWidth = 22
        xlObject.ActiveWorkbook.ActiveSheet.Columns("K:K").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("L:L").ColumnWidth = 0
       xlObject.ActiveWorkbook.ActiveSheet.Columns("L:L").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("M:M").ColumnWidth = 0
       xlObject.ActiveWorkbook.ActiveSheet.Columns("M:M").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("N:N").ColumnWidth = 0
       xlObject.ActiveWorkbook.ActiveSheet.Columns("N:N").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("O:O").ColumnWidth = 0
       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 of 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 = "Rermove from preprocessor"




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

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

Open in new window


Where do i insert the code?

Thanks again for your help.
LVL 11
Wilder1626Asked:
Who is Participating?
 
inthedarkCommented:
We need to make 2 changes.

The only but you will need to figure out is in step 2 lTEstCol (see below) which column you need to test 13 or 14 as not sure how it will be numbered you need
Debug.Print sFields(14)
Stop
While you are testing to make sure column 14 is the right column

========Step 1
In the area:
  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

Open in new window


Change like this:

Dim sGrid() As String ' A place to collect the data from the grid
 
    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
        sGrid() =  Split(.Clip, vbCr)  'Save data from grid into an array

    End With

Open in new window


=================
Step 2

Also in the area:

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

Open in new window


Delete the above 2 rows and replace with the following:

Dim lRow As Long ' row counter
Dim sFields() As String ' place to hold the fields within a single row
dim lCol As Long ' column counter

Dim lSaveRows As Long ' The number of rows to keep

lSaveRows = 0

Dim lTestCol As Long 

Dim eData() As Variant

dim lColMax As Long


' need to see how many columns there are so use the first row
sFields = Split(sGrid(0), vbTab) ' Split the row string into fields
lColMax = uBound(sFields) ' Store the number of columns in the first row



' Loop through the grid
For lRow = ) To Ubound(sGrid)
    sFields = Split(sGrid(lRow), vbTab) ' Split the row string into fields
     
    lTestCol = 14 ' 13 or maybe 14 not sure exactly you need to check which column starting from 0 
  
    If lCol <= ubound(sFields) Then ' check that this row has all expected columns

       If sFields(lCol)<>"NEEDS TO BE REMOVED" Then 
           
          ' Save the row 
          sGrid(lSaveRows) = sGrid(lRow)
                      
           lSaveRows = lSaveRows +1

       End If
    End If
Next


lSaveRows = lSaveRows - 1


' The problem is that there is some rows in eData() that are not needed
' we need to convert the data into a variant array

Dim eData(lSaveRows, lColMax)
For lRow = 0 To lSaveRows
     sFields = Split(sGrid(lRow), vbTab)
     For lCol = 0 To lColMax
        eData(lRow,lCol)= sFields(lCol)
     Next
Next
 
' release space taken by temporary data 
Erase sFields
Erase sGrid

' Now move the data to excel
xlObject.ActiveWorkbook.ActiveSheet.Range("A6").Resize(lSaveRows + 1, lColMax + 1).Value =eData
    
Erase eData

Open in new window



-----------------End of step 2
0
 
aikimarkCommented:
I don't see any statement that references
.TextMatrix(i, 14)
0
 
inthedarkCommented:
I can see where how to achieve this.  The code example uses the clipboard which has problems transferring data to excel.

I will create some better code as a replacement which will be just as fast and less prone to clipboard problems.  (I tried using the clipboard in the past and got so many problems that I had to find a better solution.

Back soon........with some code


0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

 
Wilder1626Author Commented:
Hello all

Ok, i have change the code now.

But i have a new issue. compilation error: constant required on this part of the code: lColMax


Dim eData(lSaveRows, lColMax)

Open in new window


What is that error?
0
 
Robberbaron (robr)Commented:
try changing to

ReDim eData(lSaveRows, lColMax)

Open in new window

0
 
Wilder1626Author Commented:
oh, now it work.

But everything transfer now. Not only the: If sFields(lCol) <> "NEEDS TO BE REMOVED" Then

This is the full code:

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
               
Dim sGrid() As String ' A place to collect the data from the grid
 
    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
        sGrid() = Split(.Clip, vbCr)   'Save data from grid into an array

    End With
    
    With xlObject.ActiveWorkbook.ActiveSheet
    
   xlObject.ActiveWorkbook.ActiveSheet.Range("a1") = "Remove from preprocessor"
    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 of 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 = 14
       
       xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("D:D").ColumnWidth = 16
       xlObject.ActiveWorkbook.ActiveSheet.Columns("D:D").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 14
       xlObject.ActiveWorkbook.ActiveSheet.Columns("B:B").HorizontalAlignment = xlLeft
       xlObject.ActiveWorkbook.ActiveSheet.Columns("C:C").ColumnWidth = 14
       
        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("G:G").NumberFormat = "@"
        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 = 22
        xlObject.ActiveWorkbook.ActiveSheet.Columns("J:J").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("K:K").ColumnWidth = 22
        xlObject.ActiveWorkbook.ActiveSheet.Columns("K:K").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("L:L").ColumnWidth = 0
       xlObject.ActiveWorkbook.ActiveSheet.Columns("L:L").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("M:M").ColumnWidth = 0
       xlObject.ActiveWorkbook.ActiveSheet.Columns("M:M").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("N:N").ColumnWidth = 0
       xlObject.ActiveWorkbook.ActiveSheet.Columns("N:N").HorizontalAlignment = xlLeft
        xlObject.ActiveWorkbook.ActiveSheet.Columns("O:O").ColumnWidth = 0
       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 of 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


       
      Dim lRow As Long ' row counter
Dim sFields() As String ' place to hold the fields within a single row
Dim lCol As Long ' column counter

Dim lSaveRows As Long ' The number of rows to keep

lSaveRows = 0

Dim lTestCol As Long

Dim eData() As Variant

Dim lColMax As Long


' need to see how many columns there are so use the first row
sFields = Split(sGrid(0), vbTab) ' Split the row string into fields
lColMax = UBound(sFields) ' Store the number of columns in the first row



' Loop through the grid
   For lRow = 1 To UBound(sGrid)
    sFields = Split(sGrid(lRow), vbTab) ' Split the row string into fields
     
    lTestCol = 14 ' 13 or maybe 14 not sure exactly you need to check which column starting from 0
  
    If lCol <= UBound(sFields) Then ' check that this row has all expected columns

       If sFields(lCol) <> "NEEDS TO BE REMOVED" Then
           
          ' Save the row
          sGrid(lSaveRows) = sGrid(lRow)
                      
           lSaveRows = lSaveRows + 1

       End If
    End If
Next


lSaveRows = lSaveRows - 1


' The problem is that there is some rows in eData() that are not needed
' we need to convert the data into a variant array
    

ReDim eData(lSaveRows, lColMax)
'Dim eData(lSaveRows, lColMax)
For lRow = 0 To lSaveRows
     sFields = Split(sGrid(lRow), vbTab)
     For lCol = 0 To lColMax
        eData(lRow, lCol) = sFields(lCol)
     Next
Next
 
' release space taken by temporary data
Erase sFields
Erase sGrid

' Now move the data to excel
xlObject.ActiveWorkbook.ActiveSheet.Range("A6").Resize(lSaveRows + 1, lColMax + 1).Value = eData
    
Erase eData


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


xlObject.ActiveWindow.FreezePanes = True

xlObject.ActiveWorkbook.ActiveSheet.Name = "Rermove from preprocessor"




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

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

Open in new window

0
 
Wilder1626Author Commented:
Something is weird

I don't see where it filter by  
lTestCol = 14 ' 13 or maybe 14 not sure exactly you need to check which column starting from 0 

Open in new window



It just say:    If sFields(lCol)<>"NEEDS TO BE REMOVED" Then

But lCol =  what?


 Loop through the grid
For lRow = ) To Ubound(sGrid)
    sFields = Split(sGrid(lRow), vbTab) ' Split the row string into fields
     
    lTestCol = 14 ' 13 or maybe 14 not sure exactly you need to check which column starting from 0 
  
    If lCol <= ubound(sFields) Then ' check that this row has all expected columns

       If sFields(lCol)<>"NEEDS TO BE REMOVED" Then 
           
          ' Save the row 
          sGrid(lSaveRows) = sGrid(lRow)
                      
           lSaveRows = lSaveRows +1

       End If
    End If
Next

Open in new window

0
 
inthedarkCommented:

Sorry the lcol should have been lTestCol in the following:


 If lTestCol <= ubound(sFields) Then ' check that this row has all expected columns

and also in

If sFields(lTestCol)<>"NEEDS TO BE REMOVED" Then


           
       
0
 
inthedarkCommented:
But you need to check the column number is correct by putting a
debug.print "13="+sFields(13)
debug.print "14="+sFields(14)
stop


0
 
Wilder1626Author Commented:
Ok, let me try this and i will let you know the result.

Thanks again
0
 
ArkCommented:
You can copy/paste it one by one:
With xlObject.ActiveWorkbook.ActiveSheet
'Your excell preparing/formatting code

   With Form29.MSHFlexGrid1
Dim rowNum As Long
For i=0 to .Rows-1
    If .TextMatrix(i, 14) = "NEEDS TO BE REMOVED" Then
        .Col = 0               'From first column
        .Row = i               'From matching row
        .ColSel = .Cols - 1    'Select all columns
        .RowSel = 1           'Select ONE rows
        Clipboard.SetText .Clip 'Send to Clipboard
       xlObject.ActiveWorkbook.ActiveSheet.Range("A" & 6+rowNum).Select 'Select Cell A1 (will paste from here, to different cells)
        xlObject.ActiveWorkbook.ActiveSheet.Paste   'Paste clipboard content
       rowNum=rowNum+1
    End If
Next i
    End With

Open in new window

0
 
Wilder1626Author Commented:
Thanks to everybody.

It's working very good now.

Thanks for all your help
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.