SQLserving
SQLserving

Reputation: 400

Looking up range condition on a another range

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

  1. select xl2 workbook

  2. Look for columns From and To

  3. 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

Answers (1)

Plagon
Plagon

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:

enter image description here

Second File looks like this:

enter image description here

(Note: I use the german version so there are "," for decimals instead of ".")

Upvotes: 1

Related Questions