Solved with the following Excel VBA Code (Havn't checked if it's the most
efficient but it works):
Sub Macro1()
On Error Resume Next
Dim LastRow As Long, FirstRow As Long, LastCol As Long, FirstCol As Long
Dim blnExistingGroupIndicator As Boolean, blnColumnHasGroups(1 To 400)
As Boolean '(Columns)
Dim blnCurrentColumnHasGroups As Boolean, blnExistingGroup As Boolean
Dim intCurrentColumn As Integer, intCurrentRow As Integer
Dim intCurrentComparedRow As Integer, i As Integer
Dim strCurrentCellValue As String, strCurrentComparedValue As String
Dim intCurrentGroupColor As Integer, lngCurrentRGBColor As Long
Application.Cursor = xlWait
FirstRow = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlNext,
SearchOrder:=xlByRows).Row
FirstCol = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlNext,
SearchOrder:=xlColumns).Column
LastRow = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious,
SearchOrder:=xlByRows).Row
LastCol = ActiveSheet.Cells.Find(What:="*", SearchDirection:=xlPrevious,
SearchOrder:=xlByColumns).Column
For intCurrentColumn = 2 To LastCol
blnColumnHasGroups(intCurrentColumn) = False
For intCurrentRow = 2 To (LastRow - 1)
strCurrentCellValue = ActiveSheet.Range(Cells(intCurrentRow,
intCurrentColumn), Cells(intCurrentRow, intCurrentColumn)).Value
For intCurrentComparedRow = (intCurrentRow + 1) To LastRow
blnExistingGroupIndicator = False
strCurrentComparedValue =
ActiveSheet.Range(Cells(intCurrentComparedRow, intCurrentColumn),
Cells(intCurrentComparedRow, intCurrentColumn)).Value
If strCurrentCellValue = strCurrentComparedValue Then
If blnColumnHasGroups(intCurrentColumn) Then
blnExistingGroup = False
For i = 2 To (intCurrentComparedRow - 1)
If i <> intCurrentRow Then
If strCurrentComparedValue =
ActiveSheet.Range(Cells(i, intCurrentColumn), Cells(i,
intCurrentColumn)).Value Then
blnExistingGroup = True
End If
End If
Next i
If Not blnExistingGroup Then
blnExistingGroupIndicator = True
End If
Else
blnExistingGroupIndicator = True
End If
If blnExistingGroupIndicator Then
intCurrentGroupColor = intCurrentGroupColor + 1
End If
Select Case intCurrentGroupColor
Case 1
lngCurrentRGBColor = RGB(255, 0, 0) 'Red
Case 2
lngCurrentRGBColor = RGB(0, 255, 0) 'Green
Case 3
lngCurrentRGBColor = RGB(255, 255, 0) 'Yellow
Case 4
lngCurrentRGBColor = RGB(0, 0, 255) 'Blue
Case 5
lngCurrentRGBColor = 16711935 'Violet
Case 6
lngCurrentRGBColor = RGB(0, 255, 255) 'Cyan
intCurrentGroupColor = 0
End Select
If blnExistingGroupIndicator Then
ActiveSheet.Range(Cells(intCurrentRow,
intCurrentColumn), Cells(intCurrentRow, intCurrentColumn)).Interior.Color =
lngCurrentRGBColor
End If
ActiveSheet.Range(Cells(intCurrentComparedRow,
intCurrentColumn), Cells(intCurrentComparedRow,
intCurrentColumn)).Interior.Color = ActiveSheet.Range(Cells(intCurrentRow,
intCurrentColumn), Cells(intCurrentRow, intCurrentColumn)).Interior.Color
blnColumnHasGroups(intCurrentColumn) = True
End If
Next intCurrentComparedRow
Next intCurrentRow
Next intCurrentColumn
i = 0 'Used because each deletion moves the rows left
For intCurrentColumn = 2 To LastCol
If Not blnColumnHasGroups(intCurrentColumn) Then
ActiveSheet.Columns(intCurrentColumn - i).Delete
i = i + 1
End If
Next intCurrentColumn
Application.Cursor = xlDefault
End Sub
Thank you very much guys for your help!
Kind Regards,
Amir.
Marshall Barton said:
Well, I've tried to think about this new twist, but I'm
afraid that it is whole lot more than "a bit more
complicated". In fact, I seriously doubt that it can be
done with a query. If it can, it's way beyond my SQL
skills.
I don't understand enough about the problem to try to figure
it out, but I think you will need to open a recordset on the
table and use a lot of code to perform this kind of
analysis.
--
Marsh
MVP [MS Access]
Thank you Marshall, you solution works great.
What I'm looking for is a bit more complicated: I want the program to help
me identify WHICH FIELDS has duplicated values, and display the records
which has these duplicated values. I want to distinguish between different
"cases". I am willing for "answers" like:
* Records which have same values in field1:
Records 1, 2, 5, Field1: 0
Records 3, 4, 6, Field1: 1
* Records which have same values in field2:
Records 1 , 4. Field1: 1
Records 2,3,5,6 Field1: 0
...
(and for the more complicated cases
* Records which have same values in fields 1, 3 and 4:
Records 1 , 2. Field1: 0, Field 3: 0, Field 4: 0.
Records 4 , 6. Field1: 1, Field 3: 1, Field 4: 0. (note that different
fields do NOT have to be equal. The condition is that values in the SAME
FIELD but from DIFFERENT RECORDS will be equal, but this doesn't mean that
all the fields that are checked should be equal, as in this example, for
1,
1, 0)
* Records which has same values in fields 1,2,3,4 (This line will not be
displayed because there are no such records. Again, note that Record 2 has
0's in all of the fields, but that's not what the program should look for,
but for different records which has same values in the fields, so it
should
check for each field seperately)
etc.
I think can solve this quite easily by using Excel: If I export all the
records to Excel, all I have to do is to run the following procedure for
each COLUMN (field):
- store the value of the first row (record) in a variable
- check for the values in the rest of the rows in the current column. If
one
of the values is different from the value in the variable, delete the
current column and move to the next one.
This will give me all the fields which has same values for ALL the
records,
which is not such bad, but not as good as what i've described previously.
