• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 425
  • Last Modified:

Find and highlite all double in Grid

Hello all

I need to be able to locate all doubles in my MSHFlexGrid1

It need's to base on this:

If Column3 (Carrier_ID) and Column5 (Origin_Reg) and Column9 (Destination) have more then 1 row, it need's to put all the cells row in color.

Ex on this picture bellow, there is a double for test1 / T2C / L1W 4C1.

It would be good to only highlight the doubles excluding the first row value. But if it's not possible, i dont mind that they are all highlighted.

Thanks again for your help


find-doubles.bmp
0
Wilder1626
Asked:
Wilder1626
  • 11
  • 9
1 Solution
 
Brook BraswellApplication Development ManagerCommented:
In your query that calls this data....do you have a unique Identifier for Each Row?

I built a sample of this data and run with the following query...

SELECT *,
( SELECT COUNT(*) FROM CARRIERS B WHERE B.CARRIER_ID = A.CARRIER_ID AND B.ORIGIN01 = A.ORIGIN01 AND B.DESTINATION01 = A.DESTINATION01 ) AS DUPE
  FROM CARRIERS A

use the DUPE column to indicate more than 1...

if you have an identifier then...

SELECT *,
( SELECT COUNT(*)
    FROM CARRIERS B
   WHERE B.CARRIER_ID = A.CARRIER_ID
     AND B.ORIGIN01 = A.ORIGIN01
     AND B.DESTINATION01 = A.DESTINATION01
     AND B.RATE_ID < A.RATE_ID) AS DUPE
  FROM CARRIERS A

Then highlight only rows where DUPE = 1
0
 
Wilder1626Author Commented:
wow, ok, i will try this now. Does it have to be sorted first in the data base?
0
 
Wilder1626Author Commented:
What i am using at this moment to import in my GRID is this:
Dim xlObject     As Excel.Application
Dim xlWB         As Excel.Workbook
Dim NoOfRows     As Long
Dim NoOfColumns  As Long

    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)

            Clipboard.Clear
            xlObject.Cells.Copy     ' Copy all cells in active worksheet.
            FetchNoRowCol xlObject.ActiveWorkbook.ActiveSheet, NoOfRows, NoOfColumns
            With MSHFlexGrid1
               .Redraw = False     'Dont draw until the end, so we avoid that flash
               .Rows = NoOfRows
               .Cols = NoOfColumns
               .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
               .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
    
    Dim r As Long, txt As String, total As Long
For r = 1 To MSHFlexGrid1.Rows - 1
  If Len(MSHFlexGrid1.TextMatrix(r, 3)) Then total = total + 1

Next r
lblTotalrecord = CStr(total)

   
    Exit Sub

MyErrHandler:
    Err.Clear

Open in new window

0
Cloud Class® Course: CompTIA Cloud+

The CompTIA Cloud+ Basic training course will teach you about cloud concepts and models, data storage, networking, and network infrastructure.

 
Brook BraswellApplication Development ManagerCommented:
So your grid does not come from a database but rather an excel sheet
are you able to make changes to your excel sheet?
if so ...add a column that checks for the dupes...
if you have a sample of it I could show you how...
0
 
Wilder1626Author Commented:
Yes and NO.

Yes i could do something in the excel sheet but since this excel sheet comes from somebody else, i want my VB6 tool to fix it.

Once fix, i have a button to export in Excel to send back to the requester.
0
 
Brook BraswellApplication Development ManagerCommented:
if the data in the excel is not sorted...
then do an sort with the excel object
add a column to the excel object
and run through the rows...adding the DUPE value when the previous columns match...
0
 
Wilder1626Author Commented:
Not sure to fully understand.

Do i need to sort in the excel sheet or in the grid?
0
 
Brook BraswellApplication Development ManagerCommented:
If you can sort in the sheet that would be preferable...
but if you can not control that then sort in the grid
0
 
Wilder1626Author Commented:
Hello again,

Ok, now i did the filter:
Private Sub MSHFlexGrid1_DblClick()
  With MSHFlexGrid1
        .ColSel = 8
        .Sort = flexSortStringAscending
        .ColSel = 6
        .Sort = flexSortStringAscending
         .ColSel = 3
        .Sort = flexSortStringAscending
    End With
End Sub

Open in new window


What do i need to do know that i highlight all duplicate?
0
 
Brook BraswellApplication Development ManagerCommented:
Wilder:
I am building a test project for you...
what is in your process "FetchNoRowCol" ?
0
 
Wilder1626Author Commented:
What do you meen by FetchNoRowCol?

Not sure to understand.
0
 
Brook BraswellApplication Development ManagerCommented:
Well from your code above you are calling this function...not important now..I made a workaround
0
 
Wilder1626Author Commented:
Oh ok,

Thanks
0
 
Brook BraswellApplication Development ManagerCommented:
In your excel sheet...
Are the 3 columns you gauge against always in the same position?
0
 
Brook BraswellApplication Development ManagerCommented:
OK...
You may need to "tweek" the Frmla field in this to suit your needs...
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

    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 = 4 - (NoOfColumns + 1)
            C2 = 6 - (NoOfColumns + 1)
            C3 = 10 - (NoOfColumns + 1)
            
            Frmula = "=IF(RC[" & C1 & "]=R[-1]C[" & C1 & "],IF(RC[" & C2 & "]=R[-1]C[" & C2 & "],IF(RC[" & C3 & "]=R[-1]C[" & C3 & "],1,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 = vbGreen
                     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
            Set xlSH = Nothing
        End If
    End With
    
    Dim r As Long, txt As String, total As Long
For r = 1 To MSHFlexGrid1.Rows - 1
  If Len(MSHFlexGrid1.TextMatrix(r, 3)) Then total = total + 1

Next r
lblTotalrecord = CStr(total)

   
    Exit Sub

MyErrHandler:
    Err.Clear

Open in new window

0
 
Wilder1626Author Commented:
Yes, the 3 columns are always in the same position.

Thanks, i will try this now and let you know.

Thanks again for your help.
0
 
Wilder1626Author Commented:
I have a variable not define on:

Set xlSH = Nothing
0
 
Brook BraswellApplication Development ManagerCommented:
I left that in there by mistake...I was experimenting with a sheet object...\
just delete that line of code
:)
0
 
Wilder1626Author Commented:
Ok,

I will do some test cause i have a file with 2 duplicate and it only highlight one of them when i use this code.

Probably just a small adjustment.
0
 
Wilder1626Author Commented:
Wow, this is great.

Thanks

I can only do up to 7500 rows.

But i will manage.

I guess this is the max.

Thanks again
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.

Join & Write a Comment

Featured Post

Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 11
  • 9
Tackle projects and never again get stuck behind a technical roadblock.
Join Now