Solved

Find and highlite all double in Grid

Posted on 2011-03-08
20
400 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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
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

What Is Threat Intelligence?

Threat intelligence is often discussed, but rarely understood. Starting with a precise definition, along with clear business goals, is essential.

Join & Write a Comment

Introduction I needed to skip over some file processing within a For...Next loop in some old production code and wished that VB (classic) had a statement that would drop down to the end of the current iteration, bypassing the statements that were c…
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 …
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…
Show developers how to use a criteria form to limit the data that appears on an Access report. It is a common requirement that users can specify the criteria for a report at runtime. The easiest way to accomplish this is using a criteria form that a…

705 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

18 Experts available now in Live!

Get 1:1 Help Now