Question

Ok, greetings all this is my first post (certainly not my last since I'm the only person working on this project). I have very VERY little VBA experience so what you see is kinda similar to my "hello world".

To make a long story short... I would like to compare two rows in a dynamic ranged sheet (gets updated from an access database upon opening) and find a row that matches exactly for the first four columns (see below code).

Then compare the seventh column for the highest value out of the two compared rows. (Full, Adequate, and Basic are the values to be compared from highest to lowest)

Then, after all these criteria have been met, throw away the lowest and keep the highest. FOR ALL ROWS (in other words a While Loop).

This code is for a training database at my place of employment, there are a lot of the same entries with different levels of understanding as the employee continues the training. this code should take all the training done and keep only the highest valued (best representation of their capabilities) and trash the other "obselete" entries.

Here's my worthless code:

Sub RemoveDuplicates()
Dim Bottom As Integer
Dim FalseBottom As Integer
'remove lower leveled duplicate entries
Bottom = CInt(Cells(Rows.Count, "A").End(xlUp).Row) 'initializes the bottom of the    list (total number of entries)
Do Until Bottom = 0
 FalseBottom = 1
 If Not IsEmpty(Cells(Bottom, "A")) Then
  Do Until FalseBottom = Bottom
   If ((Cells(FalseBottom, "A").Text = Cells(Bottom, "A").Text) And (Cells  (FalseBottom, "B").Text = Cells(Bottom, "B").Text) And (Cells(FalseBottom, "C").Text = Cells(Bottom, "C").Text) And (Cells(FalseBottom, "D").Text = Cells(Bottom, "D").Text)) Then
  '(Cells(FalseBottom, "G").Text > Cells(Bottom, "G").Text)
    If (Cells(Bottom, "G").Text = "Full") Then
     Rows(FalseBottom).Delete Shift:=xlUp
     FalseBottom = FalseBottom - 1
    End If
    If ((Cells(Bottom, "G").Text = "Adequate") And (Cells(FalseBottom, "G").Text = "Basic")) Then
     Rows(FalseBottom).Delete Shift:=xlUp
     FalseBottom = FalseBottom - 1
    End If
    If (Cells(FalseBottom, "G").Text = "Full") Then
     Rows(Bottom).Delete Shift:=xlUp
    End If
    If ((Cells(FalseBottom, "G").Text = "Adequate") And (Cells(Bottom, "G").Text = "Basic")) Then
     Rows(Bottom).Delete Shift:=xlUp
    End If
  End If
  FalseBottom = FalseBottom + 1
  Loop
  End If
 Bottom = Bottom - 1
Loop
End Sub

to better explain further, in my excel sheet I have

A    |B    |C       |D      |E          |F          |G
---------------------------------------------------------------
First|Last |Category|Task   |Performance|Requirement|Understanding
---------------------------------------------------------------
Joe  |Smoe |Cleaning|Toilets|10         |10         |Basic
Joe  |Smoe |Cleaning|Toilets|10         |10         |Adequate
Joe  |Smoe |Cleaning|Toilets|10         |10         |Full
Joe  |Smoe |Cleaning|Showers|10         |10         |Basic
Jane |Plane|Cleaning|Toilets|10         |10         |Basic
...
...

basically is there a way to find (throughout all the rows) places where the first 4 columns match, then compare the last column to see which is the highest level and discard the other matches?

Was it helpful?

Solution

FIXED PROBLEM!!

changed the .Text to .Value

split apart the If Statements

Assigned the values to thier own variables for readability

and worked like a charm... no clue why but I'll take it.

Licensed under: CC-BY-SA with attribution
Not affiliated with StackOverflow
scroll top