Need some help with a difficult loop 2

[nathanstevenson]

Hi there,

Here is the problem:
I have to give unique IDs to 9 different sets of data stored
in 15 different columns in an Excel file.

So I need a loop that will number cell B1 - 1 and put it in cell A1 (i.e. the column to store the unique ID). It needs to then take cell B1 and compare it to cells B2-B1000. If B1 equals any other cells in this range, then it's corresponsing "A" cell needs to be numbered the same as B1. Once this is done for the whole range, it is then repeated using cell B2, and so on until it is done.

The trick comes in when I have to compare two or more columns to others. i.e. b1 and c1 need to be compared to b2 and c2 etc.

My main problem is how I store the values from the cells. Do I use named ranges? If so how? How do I refer to col a1 (i.e. the ID col), ito variables as opposed to fixed locations?

This loop also needs to be repeated a couple of times on dif data.

 

[RobBroekhuis]

Yes, the code inserts two columns for the temporary calculations, then removes them after the values are copied over to the A column. You could add additional columns with either Mike's or my approach without too much extra effort. Mike's approach (traditional sequential programming) is a little cleaner from a programming point of view - doesn't depend on complicated excel worksheet formulas, so it will be easier to customize later on, if necessary.

Rob

 

[mwolf00]

Even if you do use my solution, Rob's "EndRow = Range("B1&quot.End(xlDown).Row" is very handy for finding the last row number.... Get the Best Answers! faq333-2924
Happy 2003!
mikewolf@tst-us.com

 

[nathanstevenson]

Hi Guys,

I have posted a final copy for everyone's use, as I find it a very powerful piece of code.

Sub CompareAndID()

' Description:
' A programme designed to assign a unique ID to a set of data based on
' two values. It will recurse through the entire dataset and assign each
' unique entry the same ID, then progress and do the same for the other data.

' Use:
' When importing data into a clean Access database, it may be necessary to
' split the data up into your predefined tables. To maintain the relationship between
' the data while still making sure all entries are only stored once, unique IDs need
' to be assigned to table data. This programme simplifies the task so that a direct
' import into Access is possible.

' This is algorithm was developed by Mike Wolf, with additions and alterations
' from Rob Broekhuis and Nathan Stevenson in the Tek-Tips (VBA) forum.

http://www.tek-tips.com

' Date: 03 Jan 2003.

Dim bVal As String ' variable for first col to be compared
Dim cVal As String ' variable for second col to be compared
Dim i As Integer ' the row to start comparing from
Dim j As Integer ' subsequent rows to be compared
Dim IDnumber As Integer ' ID number to be assigned
Dim col1 As Integer ' the column in which first comparison field is found
Dim col2 As Integer ' the column in which first comparison field is found
Dim colID As Integer ' the column in which the assigned ID no should be placed
Dim totalrows As Integer ' the total number of rows to be compared


' Assign values to your parameters
i = 2
IDnumber = 1
colID = 18
col1 = 19
col2 = 20
totalrows = 783

bVal = Cells(i, col1).Value ' Puts value of cell col1i into bVal
cVal = Cells(i, col2).Value ' Puts value of cell col2i into cVal

For i = 1 To totalrows ' If you have vals in rows 1 to 1000
For j = i To totalrows ' look at all the remaining rows
If Cells(j, col1).Value = bVal And Cells(j, col2) = cVal Then ' Loop through all and
Cells(j, colID).Value = IDnumber ' If col1 and col2 match first
End If ' entry then assign currentID
Next
If i < totalrows Then ' If not then go to next entry to be compared
If Cells(i + 1, colID) = 0 Or Null Then ' See if the next cell has been identified as matching
bVal = Cells(i + 1, col1).Value ' a higher row - if 0 then it has NOT been matched
cVal = Cells(i + 1, col2).Value ' So put new entries into bVal and cVal to be used as
Else ' the new set for comparison
Do While i <= totalrows
i = i + 1 ' Find the next row where col1 and col2 have not been matched
If Cells(i + 1, colID).Value = 0 Or Null Then
bVal = Cells(i + 1, col1).Value
cVal = Cells(i + 1, col2).Value
Exit Do
End If
Loop
End If
IDnumber = IDnumber + 1 ' Increment the ID number
End If
Next
End Sub

Thanks again guys!
Cheers Nathan