Reputation: 400
I am working between two workbooks.
xl1 is a routine workbook like this
StudentID |From |To
1 |2 |9
2 |20 |50
3 |0 |1
xl2 is the other workbook which is like this:
From| To
0 | 1.5 'Associate 1 with this as an ID
2 | 15 'Associate 2 with this as an ID and so on
I am trying to write a code in xl1 that would let me
select xl2 workbook
Look for columns From and To
Check in xl1 workbook to see if the From and To for each student falls within the From and To range of xl2 and then associate an ID to it. To make it clear (something like this):
StudentID |From |To |ID
1 |2 |9 |2
2 |20 |50 |
3 |0 |1 |1
So far I have written this code, but I cant seem to figure how to get the logic in:
Sub getID()
Dim wb As Workbook
Dim ws As Worksheet
Dim fd As FileDialog
Dim filename As String
Dim rng As Integer
Dim counter As Integer
Dim frm As Range
Dim too As Range
Dim lngCount As Integer
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With fd
If .Show Then
FileName = .SelectedItems(1)
Else
'if user pressed CANCEL - exit sub
MsgBox "User pressed CANCEL"
Exit Sub
End If
On Error Resume Next
Set wb = Workbooks.Open(FileName)
rng = ActiveSheet.UsedRange.Rows.Count
frm = ActiveSheet.Range("AA" & rng).Select 'copy from col
too = ActiveSheet.Rang("AC" & rng).Select 'copy to col
For Each Cell In frm
if()
Next Cell
Next
End If
End With
End Sub
The example basically means
xl2.from<xl1.from<xl2.to
and
xl2.from<xl1.to<xl2.to
I would appreciate help in getting this to work
Upvotes: 0
Views: 64
Reputation: 3139
So this compares every Dataset in the first file with the second file. And give out the matching ID in Column D. You did not say anything about multiple matches, so it will put all matches in the cell and seperate them with a ";".
Sub getID()
Dim wb As Workbook
Dim sht As Worksheet, sht2 As Worksheet
Dim fd As FileDialog
Dim lRow As Long, lRow2 as Long
Dim i as Integer, j as Integer
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set fd = Application.FileDialog(msoFileDialogFilePicker)
Set sht = ActiveWorkbook.ActiveSheet
With fd
.AllowMultiSelect = False
.Filters.Add "Excel", "*.xl*"
End With
If fd.Show = -1 Then
Set wb = Workbooks.Open(fd.SelectedItems(1))
Set sht2 = wb.Worksheets(1) 'First Sheet in File
lRow = sht.Cells(sht.Rows.Count, 2).End(xlUp).Row
LRow2 = sht2.Cells(sht2.Rows.Count, 1).End(xlUp).Row
sht.Columns(4).ClearContents 'Clear Old Data in Column "D"
sht.Cells(1, 4).Value = "ID" 'Title of Col
For i = 2 To lRow
For j = 2 To LRow2
If sht.Cells(i, 2).Value >= sht2.Cells(j, 1).Value _
And sht.Cells(i, 3).Value <= sht2.Cells(j, 2).Value Then 'Checks if From and To are in Range
If sht.Cells(i, 4).Value <> "" Then 'if more than one ID
sht.Cells(i, 4).Value = sht.Cells(i, 4).Value & ";" & j - 1 'Seperate ID with ";" ID
Else
sht.Cells(i, 4).Value = j - 1 'ID
End If
End If
Next j
Next i
wb.Close
End If
End Sub
First File looks like this with the result:
Second File looks like this:
(Note: I use the german version so there are "," for decimals instead of ".")
Upvotes: 1