Solved

Find and highlite all double in Grid

Posted on 2011-03-08
20
402 Views
Last Modified: 2012-05-11
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
Comment
Question by:Wilder1626
  • 11
  • 9
20 Comments
 
LVL 14

Expert Comment

by:Brook Braswell
ID: 35072775
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
 
LVL 11

Author Comment

by:Wilder1626
ID: 35073260
wow, ok, i will try this now. Does it have to be sorted first in the data base?
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 35073283
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
 
LVL 14

Expert Comment

by:Brook Braswell
ID: 35073559
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
 
LVL 11

Author Comment

by:Wilder1626
ID: 35073591
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
 
LVL 14

Expert Comment

by:Brook Braswell
ID: 35073643
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
 
LVL 11

Author Comment

by:Wilder1626
ID: 35074511
Not sure to fully understand.

Do i need to sort in the excel sheet or in the grid?
0
 
LVL 14

Expert Comment

by:Brook Braswell
ID: 35082027
If you can sort in the sheet that would be preferable...
but if you can not control that then sort in the grid
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 35082594
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
 
LVL 14

Expert Comment

by:Brook Braswell
ID: 35086189
Wilder:
I am building a test project for you...
what is in your process "FetchNoRowCol" ?
0
Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

 
LVL 11

Author Comment

by:Wilder1626
ID: 35086264
What do you meen by FetchNoRowCol?

Not sure to understand.
0
 
LVL 14

Expert Comment

by:Brook Braswell
ID: 35086373
Well from your code above you are calling this function...not important now..I made a workaround
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 35086700
Oh ok,

Thanks
0
 
LVL 14

Expert Comment

by:Brook Braswell
ID: 35086736
In your excel sheet...
Are the 3 columns you gauge against always in the same position?
0
 
LVL 14

Accepted Solution

by:
Brook Braswell earned 500 total points
ID: 35087190
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
 
LVL 11

Author Comment

by:Wilder1626
ID: 35087426
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
 
LVL 11

Author Comment

by:Wilder1626
ID: 35087452
I have a variable not define on:

Set xlSH = Nothing
0
 
LVL 14

Expert Comment

by:Brook Braswell
ID: 35088138
I left that in there by mistake...I was experimenting with a sheet object...\
just delete that line of code
:)
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 35088736
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
 
LVL 11

Author Closing Comment

by:Wilder1626
ID: 35089920
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

Featured Post

Is Your Active Directory as Secure as You Think?

More than 75% of all records are compromised because of the loss or theft of a privileged credential. Experts have been exploring Active Directory infrastructure to identify key threats and establish best practices for keeping data safe. Attend this month’s webinar to learn more.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
Excel object stays open 19 71
Put text in a picture ASP.NET C# 2 50
Copy a row 12 59
MS Access 03, TransferText, decimal places 8 47
Have you ever wanted to restrict the users input in a textbox to numbers, and while doing that make sure that they can't 'cheat' by pasting in non-numeric text? Of course you can do that with code you write yourself but it's tedious and error-prone …
Most everyone who has done any programming in VB6 knows that you can do something in code like Debug.Print MyVar and that when the program runs from the IDE, the value of MyVar will be displayed in the Immediate Window. Less well known is Debug.Asse…
Get people started with the process of using Access VBA to control Outlook using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Microsoft Outlook. Using automation, an Access applic…
Get people started with the utilization of class modules. Class modules can be a powerful tool in Microsoft Access. They allow you to create self-contained objects that encapsulate functionality. They can easily hide the complexity of a process from…

867 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

19 Experts available now in Live!

Get 1:1 Help Now