nathanstevenson
IS-IT--Management
Hi there,
Below is a routine to create unique IDs from a flat file, which enables direct importing into Access. The problem is that it takes a long time (approx 2 mins for 330 lines) to execute.
Is there someone REALLY bright out there that can help me speed this up? I don't know much about optimizing code.
Here is the routine:
Function CompareAndID(ByVal colID As Integer, NoToCompare As Integer, Optional col1 As Integer, Optional col2 As Integer, Optional col3 As Integer, Optional col4 As Integer, Optional col5 As Integer)
' 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.
'
' Additional Notes:
' One has to set the "global" parameters for i, which is the row to start comparing from and
' totalrows, which has to be the exact number of rows of data. It makes it easier to setup if a row
' with column numbers is inserted ABOVE the column headings. This row can then be removed
' for importing to the staging table.
Dim bVal As Variant ' variable for 1 col to be compared
Dim cVal As Variant ' variable for 2 col to be compared
Dim dVal As Variant ' variable for 3 col to be compared
Dim eVal As Variant ' variable for 4 col to be compared
Dim fVal As Variant ' variable for 5 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 Start number
Dim totalrows As Integer ' the total number of rows to be compared
i = 2
IDnumber = 1
totalrows = 337
' Assign values to your parameters
If IsMissing(col1) Or Null Then
Else
colID = colID
col1 = colID + 1
col2 = col1 + 1
col3 = col2 + 1
col4 = col3 + 1
col5 = col4 + 1
NoToCompare = NoToCompare
End If
Select Case NoToCompare
Case 5
bVal = Cells(i, col1).Value ' Puts value of cell col1i into bVal
cVal = Cells(i, col2).Value ' Puts value of cell col2i into cVal
dVal = Cells(i, col3).Value
eVal = Cells(i, col4).Value
fVal = Cells(i, col5).Value
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 And Cells(j, col3) = dVal And Cells(j, col4) = eVal And Cells(j, col5) = fVal 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
dVal = Cells(i + 1, col3).Value
eVal = Cells(i + 1, col4).Value
fVal = Cells(i + 1, col5).Value
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
dVal = Cells(i + 1, col3).Value
eVal = Cells(i + 1, col4).Value
fVal = Cells(i + 1, col5).Value
Exit Do
End If
Loop
End If
IDnumber = IDnumber + 1 ' Increment the ID number
End If
Next
End Select
End Function
Any help much appreciated!
Thanks,
Nathan
Below is a routine to create unique IDs from a flat file, which enables direct importing into Access. The problem is that it takes a long time (approx 2 mins for 330 lines) to execute.
Is there someone REALLY bright out there that can help me speed this up? I don't know much about optimizing code.
Here is the routine:
Function CompareAndID(ByVal colID As Integer, NoToCompare As Integer, Optional col1 As Integer, Optional col2 As Integer, Optional col3 As Integer, Optional col4 As Integer, Optional col5 As Integer)
' 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.
'
' Additional Notes:
' One has to set the "global" parameters for i, which is the row to start comparing from and
' totalrows, which has to be the exact number of rows of data. It makes it easier to setup if a row
' with column numbers is inserted ABOVE the column headings. This row can then be removed
' for importing to the staging table.
Dim bVal As Variant ' variable for 1 col to be compared
Dim cVal As Variant ' variable for 2 col to be compared
Dim dVal As Variant ' variable for 3 col to be compared
Dim eVal As Variant ' variable for 4 col to be compared
Dim fVal As Variant ' variable for 5 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 Start number
Dim totalrows As Integer ' the total number of rows to be compared
i = 2
IDnumber = 1
totalrows = 337
' Assign values to your parameters
If IsMissing(col1) Or Null Then
Else
colID = colID
col1 = colID + 1
col2 = col1 + 1
col3 = col2 + 1
col4 = col3 + 1
col5 = col4 + 1
NoToCompare = NoToCompare
End If
Select Case NoToCompare
Case 5
bVal = Cells(i, col1).Value ' Puts value of cell col1i into bVal
cVal = Cells(i, col2).Value ' Puts value of cell col2i into cVal
dVal = Cells(i, col3).Value
eVal = Cells(i, col4).Value
fVal = Cells(i, col5).Value
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 And Cells(j, col3) = dVal And Cells(j, col4) = eVal And Cells(j, col5) = fVal 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
dVal = Cells(i + 1, col3).Value
eVal = Cells(i + 1, col4).Value
fVal = Cells(i + 1, col5).Value
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
dVal = Cells(i + 1, col3).Value
eVal = Cells(i + 1, col4).Value
fVal = Cells(i + 1, col5).Value
Exit Do
End If
Loop
End If
IDnumber = IDnumber + 1 ' Increment the ID number
End If
Next
End Select
End Function
Any help much appreciated!
Thanks,
Nathan