nathanstevenson
IS-IT--Management
Greetings All,
When having to import data into an Access DB, it might be required that that data is already uniquely identified so that relationships can be maintained. This becomes very difficult when one dataset has to be imported into many different tables.
By setting all the Table IDs so that they are NOT autonum in your DB and using this programme to assign IDs to all your table related data, one can import cleanly from almost any Excel dataset. Each entry in your excel file will have a relationship thread through it, made up of each one of your unique table IDs that have been generated through this programme.
Here is the programme:
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. ' 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
It is also possible to customise this programme so that it compares more than two columns or even just one column. It is a powerful aid to importing data that has been highly beneficial to me.
Thanks to Mike Wolf and Rob Broekhuis who were the brains behind this programme!
Cheers,
Nathan
When having to import data into an Access DB, it might be required that that data is already uniquely identified so that relationships can be maintained. This becomes very difficult when one dataset has to be imported into many different tables.
By setting all the Table IDs so that they are NOT autonum in your DB and using this programme to assign IDs to all your table related data, one can import cleanly from almost any Excel dataset. Each entry in your excel file will have a relationship thread through it, made up of each one of your unique table IDs that have been generated through this programme.
Here is the programme:
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. ' 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
It is also possible to customise this programme so that it compares more than two columns or even just one column. It is a powerful aid to importing data that has been highly beneficial to me.
Thanks to Mike Wolf and Rob Broekhuis who were the brains behind this programme!
Cheers,
Nathan
