Link to home
Avatar of Wilder1626
Wilder1626Flag for Canada

asked on

Contactenate MSHFlexgrid1 issue

Hi All,

I would need your help to modify that code here:
Dim k As Long

For k = 1 To MSHFlexGrid1.Rows - 1

If MSHFlexGrid1.TextMatrix(k, 1) <> "" Then
   MSHFlexGrid1.TextMatrix(k, 11) = MSHFlexGrid1.TextMatrix(k, 0) & MSHFlexGrid1.TextMatrix(k, 1) & MSHFlexGrid1.TextMatrix(k, 7) & MSHFlexGrid1.TextMatrix(k, 8) & MSHFlexGrid1.TextMatrix(k, 9) & MSHFlexGrid1.TextMatrix(k, 10)

  End If

Next k

Open in new window


What I'm trying to do is to follow these criteria:
If rows from Column 0, 1 and 2 are the same on multiple rows, then it must concatenate all  rows with column 0, 1, 7, 8, 9, 10 in column 11 until a new value from column 0,1,2.

Foe example. If we look at the picture bellow, we see the same value 28, 16 and 00221 on 7 rows.

Then it will concatenate in all rows column 11 all the values of all rows column 0, 1, 7, 8, 9, 10 of the 7 rows to make this result:
281613600900281624600900281635600900281646600900281657600900281661600900281672600900

Open in new window


The number of rows with same value in column 0, 1 , 2 may vary.

How can i do that please?

Thanks for your help.User generated image
Avatar of eemit
eemit
Flag of Germany image

Try:
Private Sub cmdConcatenateCols_Click()
  
  Dim nRow As Long
  Dim nCol As Long
  
  Dim sSectionRowCounter As Long
  
  sSectionRowCounter = 0
  
  With MSHFlexGrid1
      For nRow = 1 To .Rows - 1
          If Len(.TextMatrix(nRow, 1)) > 0 Then
              If nRow = .Rows - 1 Then
                  ' Last Row
                  If sSectionRowCounter > 0 Then
                      Call ConcatenateCol11(nRow)
                  End If
              Else
                  If CheckNextRow(nRow) Then
                      Call ConcatenateCol11(nRow)
                      
                      sSectionRowCounter = sSectionRowCounter + 1
                  Else
                      If sSectionRowCounter > 0 Then
                          Call ConcatenateCol11(nRow)
                      End If
                      sSectionRowCounter = 0
                  End If
              End If
          Else
              sSectionRowCounter = 0
          End If
      Next nRow
      .Refresh
  End With

End Sub

Private Function CheckNextRow( _
                    ByVal nRow As Long _
                    ) As Boolean
  
  Dim sC11 As String
  
  With MSHFlexGrid1
      If nRow <= .Rows - 2 Then
          If (.TextMatrix(nRow, 0) = .TextMatrix(nRow + 1, 0)) And (.TextMatrix(nRow, 1) = .TextMatrix(nRow + 1, 1)) And (.TextMatrix(nRow, 2) = .TextMatrix(nRow + 1, 2)) Then
              CheckNextRow = True
          End If
      End If
  End With
  
  Exit Function

End Function

Private Sub ConcatenateCol11( _
                    ByVal nRow As Long _
                    )
  
  Dim sC11 As String
  
  With MSHFlexGrid1
      sC11 = .TextMatrix(nRow, 0) & .TextMatrix(nRow, 1) & .TextMatrix(nRow, 7) & .TextMatrix(nRow, 8) & .TextMatrix(nRow, 9) & .TextMatrix(nRow, 10)
      .TextMatrix(nRow, 11) = sC11
      
      '/ Optional
      .ColWidth(11) = Me.TextWidth(sC11 + "A")
      '/
  End With

End Sub

Open in new window

Try (Version 2):
Private Sub cmdConcatenateCols_Click()
  
  Dim nRow As Long
  Dim nCol As Long
  
  Dim sSectionRowCounter As Long
  Dim sSecFirstRow As Long
  Dim sSecLastRow As Long
  
  sSectionRowCounter = 0
  sSecFirstRow = 1
  sSecLastRow = 0
  
  With MSHFlexGrid1
      For nRow = 1 To .Rows - 1
          If Len(.TextMatrix(nRow, 1)) > 0 Then
              If nRow = .Rows - 1 Then
                  ' Last Row
                  If sSectionRowCounter > 0 Then
                      sSecLastRow = nRow
                      Call ConcatenateToCol11_AllCol11(sSecFirstRow, sSecLastRow)
                  End If
              Else
                  If CheckNextRow(nRow) Then
                      sSectionRowCounter = sSectionRowCounter + 1
                  Else
                      If sSectionRowCounter > 0 Then
                          sSecLastRow = nRow
                          Call ConcatenateToCol11_AllCol11(sSecFirstRow, sSecLastRow)
                      End If
                      
                      sSectionRowCounter = 0
                      sSecFirstRow = nRow + 1
                  End If
              End If
          Else
              If sSectionRowCounter > 0 Then
                  sSecLastRow = nRow
                  Call ConcatenateToCol11_AllCol11(sSecFirstRow, sSecLastRow)
              End If
              
              sSectionRowCounter = 0
              sSecFirstRow = nRow + 1

          End If
      Next nRow
      
      '/ Debug
'      For nRow = 1 To .Rows - 1
'          Debug.Print "Row-" & CStr(nRow) & ", Col-11: " & .TextMatrix(nRow, 11)
'      Next nRow
      '/
      
      Call AutoSizeColumnWidthHFlexGrid(Me.MSHFlexGrid1, 150)
      
      .Refresh
  End With

End Sub

Private Sub ConcatenateToCol11_AllCol11( _
                    ByVal nFirstRow As Long, _
                    ByVal nLastRow As Long _
                    )
  
  Dim nRow As Long
  Dim sC11 As String
  
  With MSHFlexGrid1
      If (nFirstRow >= 1) And (nLastRow <= .Rows - 1) Then
          
          sC11 = ""
          For nRow = nFirstRow To nLastRow
              sC11 = sC11 & ConcatenateToCol11(nRow)
          Next nRow
          
          For nRow = nFirstRow To nLastRow
              .TextMatrix(nRow, 11) = sC11
          Next nRow
          
      End If
  End With

End Sub

Private Function ConcatenateToCol11( _
                    ByVal nRow As Long _
                    ) As String
  
  With MSHFlexGrid1
      ConcatenateToCol11 = .TextMatrix(nRow, 0) & .TextMatrix(nRow, 1) & .TextMatrix(nRow, 7) & .TextMatrix(nRow, 8) & .TextMatrix(nRow, 9) & .TextMatrix(nRow, 10)
  End With
  Exit Function

End Function

' Optimize Column Width in MSHFlexGrid Control
Public Sub AutoSizeColumnWidthHFlexGrid( _
                        ByRef oHFlexGrid As MSHFlexGrid, _
                        ByVal nExtendInTwips As Long _
                        )

  On Error GoTo Err_Handler
  
  Dim nRow As Long
  Dim nCol As Long
  
  Dim nColumnWidth As Single

  With oHFlexGrid
      
      For nCol = 0 To .Cols - 1
          nColumnWidth = 0
          For nRow = 0 To .Rows - 1
              If Me.TextWidth(.TextMatrix(nRow, nCol)) > nColumnWidth Then
                  nColumnWidth = Me.TextWidth(.TextMatrix(nRow, nCol))
              End If
          Next
          .ColWidth(nCol) = nColumnWidth + nExtendInTwips
      Next
  End With
  
  Exit Sub
  
Err_Handler:
  Debug.Print "ERROR (AutoSizeColumnWidthHFlexGrid): " & Err.Description & ", " & CStr(Err.Number)

End Sub

'Try (Version 2 - other way):
Private Sub cmdConcatenateCols_Click()
  
  Dim nRow As Long
  Dim nCol As Long
  
  Dim sC0 As String
  Dim sC1 As String
  Dim sC2 As String
  
  Dim sSectionRowCounter As Long
  Dim sSecFirstRow As Long
  Dim sSecLastRow As Long
  
  sSectionRowCounter = 0
  sSecFirstRow = 1
  sSecLastRow = 0
  
  sC0 = vbNullString
  sC1 = vbNullString
  sC2 = vbNullString
  
  With MSHFlexGrid1
      For nRow = 1 To .Rows - 1
          If Len(.TextMatrix(nRow, 1)) > 0 Then
              If CheckRow(nRow, sC0, sC1, sC2) Then
                  sSecLastRow = nRow
                  
              Else
                  'If Len(sC0) > 0 And Len(sC1) > 0 And Len(sC2) > 0 Then
                  If sSecLastRow > sSecFirstRow Then
                      Call ConcatenateToCol11_AllCol11(sSecFirstRow, sSecLastRow)
                  End If
                  
                  sC0 = .TextMatrix(nRow, 0)
                  sC1 = .TextMatrix(nRow, 1)
                  sC2 = .TextMatrix(nRow, 2)
                  
                  sSecFirstRow = nRow
              End If
              
              If nRow = .Rows - 1 Then
                  ' Last Row
                  If sSecLastRow > sSecFirstRow Then
                      Call ConcatenateToCol11_AllCol11(sSecFirstRow, sSecLastRow)
                  End If
              End If
          
          Else
          
              If sSecLastRow > sSecFirstRow Then
                  Call ConcatenateToCol11_AllCol11(sSecFirstRow, sSecLastRow)
              End If
              
              sC0 = .TextMatrix(nRow, 0)
              sC1 = .TextMatrix(nRow, 1)
              sC2 = .TextMatrix(nRow, 2)
              
              sSecFirstRow = nRow
              
          End If
      Next nRow
      
      '/ Debug
'      For nRow = 1 To .Rows - 1
'          Debug.Print "Row-" & CStr(nRow) & ", Col-11: " & .TextMatrix(nRow, 11)
'      Next nRow
      '/
      
      Call AutoSizeColumnWidthHFlexGrid(Me.MSHFlexGrid1, 150)
      
      .Refresh
  End With

End Sub

Private Function CheckRow( _
                    ByVal nRow As Long, _
                    ByVal sC0 As String, _
                    ByVal sC1 As String, _
                    ByVal sC2 As String _
                    ) As Boolean
  
  Dim sC11 As String
  
  With MSHFlexGrid1
      If nRow <= .Rows - 1 Then
          If (.TextMatrix(nRow, 0) = sC0) And (.TextMatrix(nRow, 1) = sC1) And (.TextMatrix(nRow, 2) = sC2) Then
              CheckRow = True
          End If
      End If
  End With
  
  Exit Function

End Function

Open in new window

Avatar of Wilder1626

ASKER

Hi eemit

That looks good, let me do some more test and i will let you know.

Thanks again
Ok, after many test, there is 1 small issue.

All work when i have 7 rows of same value from column 0, 1, 2.

But if i have less then 7 rows of  same date in column 0, 1, 2, the data does not concatenate.

ex: if there is 2 rows only, it should still concatenate the data from column 0, 1, 7, 8, 9, 10, but for the 2 rows only.

If i have 3 rows, it will concatenate for 3 rows only etc....

but for a full 7 days, its working.

Thanks again
Insert (in Sub cmdConcatenateCols_Click):
      .Col = 2
      .ColSel = 0
      .Sort = flexSortGenericAscending

Below the line:
  With MSHFlexGrid1
I have updated the code to:
 With MSHFlexGrid1
  
  .Col = 2
      .ColSel = 0
      .Sort = flexSortGenericAscending
      
      
      
      For nRow = 1 To .Rows - 1
          If Len(.TextMatrix(nRow, 1)) > 0 Then
              If CheckRow(nRow, sC0, sC1, sC2) Then
                  sSecLastRow = nRow
                  

Open in new window


But still the ones with less then 3 rows if same data in column 0, 1, 2 are not concatenating. But all the rest does.
- Consider horizontal scrolling.
- Can you post a screenshot of your results?
Sure.

This is the result i have

User generated image
This are the only ones with less then 7 rows and no concatenation.
Colum 11 is right-aligned column. Have you tried to scroll grid to the right?
Here works well.
What i did is that i've added this code for column 11:
 MSHFlexGrid1.ColAlignment(11) = flexAlignLeftCenter

Open in new window


But even that, i dont see the concatenation for these ones from screenshot above.

Strange.
Change (in Function CheckRow):
If (.TextMatrix(nRow, 0) = sC0) And (.TextMatrix(nRow, 1) = sC1) And (.TextMatrix(nRow, 2) = sC2) Then

Open in new window

To:
If (Trim(.TextMatrix(nRow, 0)) = Trim(sC0)) And (Trim(.TextMatrix(nRow, 1)) = Trim(sC1)) And (Trim(.TextMatrix(nRow, 2)) = Trim(sC2)) Then

Open in new window

Humm

I have updated this:
Private Function CheckRow( _
                    ByVal nRow As Long, _
                    ByVal sC0 As String, _
                    ByVal sC1 As String, _
                    ByVal sC2 As String _
                    ) As Boolean
  
  Dim sC11 As String
  
  With MSHFlexGrid1
      If nRow <= .Rows - 1 Then
          If (Trim(.TextMatrix(nRow, 0)) = Trim(sC0)) And (Trim(.TextMatrix(nRow, 1)) = Trim(sC1)) And (Trim(.TextMatrix(nRow, 2)) = Trim(sC2)) Then
                                            
              CheckRow = True
          End If
      End If
  End With
  
  Exit Function

End Function

Open in new window


But i still see this result here:
User generated image
Are they all the same values in colums 0, 1 and 2?
1 of them as only 1 row for 00885
00905 also have only 2 row
same for 00925 / 00945 / 00965 and 00985

So only the ones with 1 row don't have the concatenations.
Please post valus of column 0, 1 and 2 from screenshot
in the same order as on the screenshot.
sure

28 / 03 / 00885
28 / 03 / 00905
28 / 03 / 00925
28 / 03 / 00945
28 / 03 / 00964
28 / 03 / 00985


Sorry, they are all on a single row.
OK Wilder1626,
I hope it works well now.
All work accept if there is only a 1 single row. I will try to see if i can add another code at the end, if the cell in column 11 still empty due to only a single row of data in column 0, 1, 2 to concatenate data from column 0, 1, 7, 8, 9, 10 for that row only.
ASKER CERTIFIED SOLUTION
Avatar of eemit
eemit
Flag of Germany image

Blurred text
THIS SOLUTION IS ONLY AVAILABLE TO MEMBERS.
View this solution by signing up for a free trial.
Members can start a 7-Day free trial and enjoy unlimited access to the platform.
See Pricing Options
Start Free Trial
Thank you so much

all good now.

Thanks again