asked on

VB6 - Transfer 1 grid to another

Hi

In my project example in attachment, i'm trying to transfer from one grid to the other by following this rule.

If Grid 1 column 0 > NULL, transfer specific cells into Grid 2.
If Grid 2 column 0 = NULL, accept the data from Grid 1.

I'm using this below code so far but it just transfer 1 row.

How can i fix this.

Thanks

Private Sub transfer_Click()
   Dim i As Integer
    Dim a As Integer


    'HEADING FOR GRID
    MSHFlexGrid2.Clear
    MSHFlexGrid2.Rows = 2
    MSHFlexGrid2.Cols = 5

    '**********************   RATES   ***************************************

    For a = 1 To MSHFlexGrid2.Rows - 1
        For i = 0 To MSHFlexGrid1.Rows - 1
            If MSHFlexGrid2.TextMatrix(a, 0) = "" Then
                If MSHFlexGrid1.TextMatrix(i, 0) <> "" Then
                    MSHFlexGrid2.TextMatrix(a, 1) = MSHFlexGrid1.TextMatrix(i, 0)  '
                    MSHFlexGrid2.TextMatrix(a, 2) = MSHFlexGrid1.TextMatrix(i, 1)  '
                    MSHFlexGrid2.TextMatrix(a, 3) = MSHFlexGrid1.TextMatrix(i, 2)  '
                    MSHFlexGrid2.TextMatrix(a, 4) = MSHFlexGrid1.TextMatrix(i, 3)  '
                    MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
                End If

            End If
        Next
    Next

End Sub

Open in new window

Form1.zip

Wilder1626

ASKER

I think i found it

    Dim i As Integer
    Dim a As Integer


    'HEADING FOR GRID
    MSHFlexGrid2.Clear
    MSHFlexGrid2.Rows = 2
    MSHFlexGrid2.Cols = 5


    For i = 1 To MSHFlexGrid1.Rows - 1
        If MSHFlexGrid1.TextMatrix(i, 1) <> "" Then
            For a = 1 To MSHFlexGrid2.Rows - 1
                If MSHFlexGrid2.TextMatrix(a, 1) = "" Then

                    MSHFlexGrid2.TextMatrix(a, 1) = MSHFlexGrid1.TextMatrix(i, 0)  '
                    MSHFlexGrid2.TextMatrix(a, 2) = MSHFlexGrid1.TextMatrix(i, 1)  '
                    MSHFlexGrid2.TextMatrix(a, 3) = MSHFlexGrid1.TextMatrix(i, 2)  '
                    MSHFlexGrid2.TextMatrix(a, 4) = MSHFlexGrid1.TextMatrix(i, 3)  '
                    MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1

                End If

            Next a
        End If
    Next i

Open in new window

Wilder1626

ASKER

No, it does not work correctly.

I'm duplicating values with the code if i add more If statement like below.

  Dim i As Integer
    Dim a As Integer


    'HEADING FOR GRID
    MSHFlexGrid2.Clear
    MSHFlexGrid2.Rows = 2
    MSHFlexGrid2.Cols = 5


    For i = 1 To MSHFlexGrid1.Rows - 1

            For a = 1 To MSHFlexGrid2.Rows - 1



                If MSHFlexGrid1.TextMatrix(i, 0) = "A" Then
                    If MSHFlexGrid2.TextMatrix(a, 1) = "" Then
                        MSHFlexGrid2.TextMatrix(a, 1) = MSHFlexGrid1.TextMatrix(i, 0)  '
                        MSHFlexGrid2.TextMatrix(a, 2) = MSHFlexGrid1.TextMatrix(i, 1)  '
                        MSHFlexGrid2.TextMatrix(a, 3) = MSHFlexGrid1.TextMatrix(i, 2)  '
                        MSHFlexGrid2.TextMatrix(a, 4) = MSHFlexGrid1.TextMatrix(i, 3)  '
                    End If
                End If


                If MSHFlexGrid1.TextMatrix(i, 0) = "C" Then
                    If MSHFlexGrid2.TextMatrix(a, 1) = "" Then
                        MSHFlexGrid2.TextMatrix(a, 1) = MSHFlexGrid1.TextMatrix(i, 0)  '
                        MSHFlexGrid2.TextMatrix(a, 2) = MSHFlexGrid1.TextMatrix(i, 1)  '
                        MSHFlexGrid2.TextMatrix(a, 3) = MSHFlexGrid1.TextMatrix(i, 2)  '
                        MSHFlexGrid2.TextMatrix(a, 4) = MSHFlexGrid1.TextMatrix(i, 3)  ' '
                    End If
                End If

                MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
            Next a
    Next i

Open in new window

Wilder1626

ASKER

I will try this way

    Dim i As Integer
    Dim a As Integer

    'HEADING FOR GRID
    MSHFlexGrid2.Clear
    MSHFlexGrid2.Rows = 2
    MSHFlexGrid2.Cols = 5


    For i = 1 To MSHFlexGrid1.Rows - 1


        If MSHFlexGrid1.TextMatrix(i, 0) = "D" Then
            For a = 1 To MSHFlexGrid2.Rows - 1
                If MSHFlexGrid2.TextMatrix(a, 1) = "" Then
                    MSHFlexGrid2.TextMatrix(a, 1) = MSHFlexGrid1.TextMatrix(i, 0)  '
                    MSHFlexGrid2.TextMatrix(a, 2) = MSHFlexGrid1.TextMatrix(i, 1)  '
                    MSHFlexGrid2.TextMatrix(a, 3) = MSHFlexGrid1.TextMatrix(i, 2)  '
                    MSHFlexGrid2.TextMatrix(a, 4) = MSHFlexGrid1.TextMatrix(i, 3)  ' '
                    MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
                End If
            Next a
        End If



        If MSHFlexGrid1.TextMatrix(i, 0) = "C" Then
            For a = 1 To MSHFlexGrid2.Rows - 1
                If MSHFlexGrid2.TextMatrix(a, 1) = "" Then
                    MSHFlexGrid2.TextMatrix(a, 1) = MSHFlexGrid1.TextMatrix(i, 0)  '
                    MSHFlexGrid2.TextMatrix(a, 2) = MSHFlexGrid1.TextMatrix(i, 1)  '
                    MSHFlexGrid2.TextMatrix(a, 3) = MSHFlexGrid1.TextMatrix(i, 2)  '
                    MSHFlexGrid2.TextMatrix(a, 4) = MSHFlexGrid1.TextMatrix(i, 3)  ' '
                    MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
                End If
            Next a
        End If

    Next i

Open in new window

Martin Liss

I don't see how grid 2 can have anything in it so this just transfers the data from grid 1 to grid 2.

Private Sub transfer_Click()
    Dim i As Integer
    Dim a As Integer


    'HEADING FOR GRID
    MSHFlexGrid2.Clear
    MSHFlexGrid2.Rows = 1
    MSHFlexGrid2.Cols = 5

    For a = 0 To MSHFlexGrid1.Rows - 1
        If MSHFlexGrid2.TextMatrix(a, 0) = "" Then
            For i = 0 To MSHFlexGrid1.Rows - 1
                If MSHFlexGrid1.TextMatrix(i, 0) <> "" Then
                    If a > MSHFlexGrid2.Rows - 1 Then
                        MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
                    End If
                    MSHFlexGrid2.TextMatrix(a, 1) = MSHFlexGrid1.TextMatrix(i, 0)  '
                    MSHFlexGrid2.TextMatrix(a, 2) = MSHFlexGrid1.TextMatrix(i, 1)  '
                    MSHFlexGrid2.TextMatrix(a, 3) = MSHFlexGrid1.TextMatrix(i, 2)  '
                    MSHFlexGrid2.TextMatrix(a, 4) = MSHFlexGrid1.TextMatrix(i, 3)  '
                    a = a + 1
                End If
            Next i
        End If
    Next a

End Sub

Open in new window

Martin Liss

This considers that there might already be data in grid 2. Please note lines 10 - 12.

Private Sub transfer_Click()
    Dim lngGrid1Row As Long
    Dim lngGrid2Row As Long


    On Error GoTo ErrorRoutine
    
    'HEADING FOR GRID
    'MSHFlexGrid2.Clear
    'NOTE: If MSHFlexGrid2 can have data in it already you don't
    '      want to do this.
    MSHFlexGrid2.Rows = 2
    
    MSHFlexGrid2.Cols = 5

    For lngGrid1Row = 0 To MSHFlexGrid1.Rows - 1
        If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) <> "" Then
            If MSHFlexGrid2.TextMatrix(lngGrid1Row, 0) = "" Then
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 2) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 1)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 3) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 2)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 4) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 3)  '
            Else
                lngGrid2Row = lngGrid2Row + 1
            End If
        End If
    Next
    Exit Sub
ErrorRoutine:
    MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
    lngGrid2Row = lngGrid2Row + 1
    Resume
End Sub

Open in new window

Wilder1626

ASKER

Hi MartiLiss

I'M looking at your second post.

I may have something in my grid already.

So if i update the code like below, I see that it jump some rows when i would like to have them one under the others.

    Dim lngGrid1Row As Long
    Dim lngGrid2Row As Long
    
     MSHFlexGrid2.Rows = 2
    
    MSHFlexGrid2.Cols = 5



    On Error GoTo ErrorRoutine
    
    'HEADING FOR GRID
    'MSHFlexGrid2.Clear
    'NOTE: If MSHFlexGrid2 can have data in it already you don't
    '      want to do this.
   
    For lngGrid1Row = 0 To MSHFlexGrid1.Rows - 1
        If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) = "A" Then
            If MSHFlexGrid2.TextMatrix(lngGrid1Row, 0) = "" Then
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 2) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 1)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 3) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 2)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 4) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 3)  '
            Else
                lngGrid2Row = lngGrid2Row + 1
            End If
        End If
        
        
         If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) = "E" Then
            If MSHFlexGrid2.TextMatrix(lngGrid1Row, 0) = "" Then
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 2) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 1)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 3) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 2)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 4) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 3)  '
            Else
                lngGrid2Row = lngGrid2Row + 1
            End If
        End If
        
        
                 If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) = "B" Then
            If MSHFlexGrid2.TextMatrix(lngGrid1Row, 0) = "" Then
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 2) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 1)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 3) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 2)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 4) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 3)  '
            Else
                lngGrid2Row = lngGrid2Row + 1
            End If
        End If
        
        
        
    Next
    Exit Sub
ErrorRoutine:
    MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
    lngGrid2Row = lngGrid2Row + 1
    Resume

Open in new window

Wilder1626

ASKER

Ok

let me put this another way.

If i have 2 button:

Botton 1:

 Dim lngGrid1Row As Long
    Dim lngGrid2Row As Long


    On Error GoTo ErrorRoutine
    
    For lngGrid1Row = 0 To MSHFlexGrid1.Rows - 1
        If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)  =  "A" Then
            If MSHFlexGrid2.TextMatrix(lngGrid1Row, 0) = "" Then
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 2) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 1)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 3) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 2)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 4) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 3)  '
            Else
                lngGrid2Row = lngGrid2Row + 1
            End If
        End If
    Next
    Exit Sub
ErrorRoutine:
    MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
    lngGrid2Row = lngGrid2Row + 1
    Resume

Open in new window

Botton 2:

 Dim lngGrid1Row As Long
    Dim lngGrid2Row As Long


    On Error GoTo ErrorRoutine
    
    For lngGrid1Row = 0 To MSHFlexGrid1.Rows - 1
        If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)  =  "E" Then
            If MSHFlexGrid2.TextMatrix(lngGrid1Row, 0) = "" Then
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 2) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 1)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 3) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 2)  '
                MSHFlexGrid2.TextMatrix(lngGrid2Row, 4) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 3)  '
            Else
                lngGrid2Row = lngGrid2Row + 1
            End If
        End If
    Next
    Exit Sub
ErrorRoutine:
    MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
    lngGrid2Row = lngGrid2Row + 1
    Resume

Open in new window

The result in MSHFlexgrid 2 should be A and E rows only

Martin Liss

I carelessly coded the ErrorRoutine to add a new row whenever any error occurred. Try the following that adds a new row only when a new row needs to be added to grid 2.

ErrorRoutine:
    If Err.Number = 381 Then
        MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
        lngGrid2Row = lngGrid2Row + 1
        Resume
    Else
        MsgBox "Error " & Err.Number & " ignored"
    End If

Open in new window

I assume that you are getting some other error that I don't get and that's what the "Else" is all about, and that part can be removed if you don't care about it.

BTW here's what I get after pre-loading "data" into row 1 of grid 2.

Wilder1626

ASKER

Sorry, I can't seem to make it work properly.

let me try again.

Martin Liss

Please attach your form again including the changes that I suggested.

Wilder1626

ASKER

Ok.

Here is the project
Form1.zip

Martin Liss

Please describe for me exactly what results you expect when each of the 3 command buttons is clicked.

Wilder1626

ASKER

Sure.

Each time i will click on one of the command it will add the data to the MSHFlexgrid2. If i click 2 time the same command, it will add 2 times the same data also.

Command 1 would transfer into grid 2 if column 0 = A
If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) = "A" Then

Command 2 would transfer into grid 2 if column 0 = E
If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) = "E" Then

Command 3 would transfer into grid 2 if column 0 = C
If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) = "C" Then

If i click on command 1 and 3, it will transfer into grid 2 if column 0 = A and C...

Martin Liss

Here's the code for the 3 buttons.

Private Sub transfer_Click()
    Dim lngGrid1Row As Long
    Dim lngGrid2Row As Long
    Dim bBlankRowFound As Boolean
    
    'MSHFlexGrid2.Rows = 2
    
    MSHFlexGrid2.Cols = 5

    For lngGrid1Row = 0 To MSHFlexGrid1.Rows - 1
        If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) = "A" Then
            For lngGrid2Row = 1 To MSHFlexGrid2.Rows - 1
                If MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = "" Then
                    bBlankRowFound = True
                    Exit For
                End If
            Next
            If Not bBlankRowFound Then
                MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
                lngGrid2Row = MSHFlexGrid2.Rows - 1
            End If
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 2) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 1)
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 3) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 2)
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 4) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 3)
            Exit For
        End If
    Next
 
End Sub

Private Sub Command_Click()
    Dim lngGrid1Row As Long
    Dim lngGrid2Row As Long
    Dim bBlankRowFound As Boolean
    
    'MSHFlexGrid2.Rows = 2
    
    MSHFlexGrid2.Cols = 5

    For lngGrid1Row = 0 To MSHFlexGrid1.Rows - 1
        If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) = "E" Then
            For lngGrid2Row = 1 To MSHFlexGrid2.Rows - 1
                If MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = "" Then
                    bBlankRowFound = True
                    Exit For
                End If
            Next
            If Not bBlankRowFound Then
                MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
                lngGrid2Row = MSHFlexGrid2.Rows - 1
            End If
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 2) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 1)
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 3) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 2)
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 4) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 3)
            Exit For
        End If
    Next
End Sub

Private Sub Command1_Click()
    Dim lngGrid1Row As Long
    Dim lngGrid2Row As Long
    Dim bBlankRowFound As Boolean
    
    'MSHFlexGrid2.Rows = 2
    
    MSHFlexGrid2.Cols = 5

    For lngGrid1Row = 0 To MSHFlexGrid1.Rows - 1
        If MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) = "C" Then
            For lngGrid2Row = 1 To MSHFlexGrid2.Rows - 1
                If MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = "" Then
                    bBlankRowFound = True
                    Exit For
                End If
            Next
            If Not bBlankRowFound Then
                MSHFlexGrid2.Rows = MSHFlexGrid2.Rows + 1
                lngGrid2Row = MSHFlexGrid2.Rows - 1
            End If
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 1) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 0)
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 2) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 1)
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 3) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 2)
            MSHFlexGrid2.TextMatrix(lngGrid2Row, 4) = MSHFlexGrid1.TextMatrix(lngGrid1Row, 3)
            Exit For
        End If
    Next
End Sub

Open in new window

Wilder1626

ASKER

HI again

I think we are almost there.

Looks like if a have multiple time the same value in: MSHFlexGrid1.TextMatrix(lngGrid1Row, 0) = "A", it does not transfer them. Only the first one.

If i have an A in 3 rows in the grid, it should transfer all 3 of them.

Same thing for all command.

Thanks again

ASKER CERTIFIED SOLUTION

Martin Liss

membership

This solution is only available to members.

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

Start Free Trial

Wilder1626

ASKER

This is perfect.

Thank again for your patience and time. I really appreciate your help.

Martin Liss

You're welcome.