Solved

Lookup Date Ranges In Excel

Posted on 2015-02-23
15
75 Views
Last Modified: 2016-02-14
I would like a formula for column b on sheet 1 in my attached example. I need the formula to look at the value in column A and lookup date ranges on sheet 2 and sheet 3 based on the value in column a on both of those sheets. This program is for employee scheduling. I need to be able to easliy show dates that will be worked on sheet 1 that summarizes sheets 2 and sheets 3.
EEExample.xlsx
0
Comment
Question by:portillosjohn
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 6
  • 6
  • 3
15 Comments
 
LVL 30

Expert Comment

by:gowflow
ID: 40626419
I would like a formula ....

Do you accept a VBA solution ?

gowflow
0
 

Author Comment

by:portillosjohn
ID: 40626442
Sure if it simple enough for me to implement.
0
 
LVL 30

Expert Comment

by:gowflow
ID: 40626447
Simple yes as long as your 'real workbook' is same in format and in row positions as the one you posted or else then will be running back and forth endlessly to adapt it correctly.

So my suggestion if you feel that the workbook you have is not the same as this one just change the confidential info and then post it.

gowflow
0
Creating Instructional Tutorials  

For Any Use & On Any Platform

Contextual Guidance at the moment of need helps your employees/users adopt software o& achieve even the most complex tasks instantly. Boost knowledge retention, software adoption & employee engagement with easy solution.

 

Author Comment

by:portillosjohn
ID: 40626766
You can use the example and I should be able to adapt it.
0
 
LVL 59

Expert Comment

by:Saurabh Singh Teotia
ID: 40626902
Their you go i wrote a UDF mlook to pick the values from the sheet in the manner you want to do..

Currently i have wrote this UDF to pick from individual worksheets...however if you want to change that to pick from all worksheets in 1 go..let me know...

In additional the way it works is-->

=Mlook(what to lookup,range where you want to look from,This for row number as in from which row you want the answer from, this is for column number i.e. which column has your answer starting from)

Let me know if you need any help on this..

Option Explicit

Function Mlook(r As Range, rng As Range, k As Long, z As Long)

    Dim cell As Range
    Dim lc As Long, ws As Worksheet
    Dim xy As Long, sp As String, lp As String, str As String

    Set ws = Sheets(rng.Parent.Name)



    lc = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column


    ' On Error Resume Next
    If Application.WorksheetFunction.CountIf(rng, r.Value) > 0 Then
        For Each cell In rng
            If cell.Value = r.Value Then

                xy = z

                Do Until xy > lc
                    If ws.Cells(cell.Row, xy).Value <> "" And sp = "" Then
                        sp = Format(ws.Cells(k, xy).Value, "m/d")
                    ElseIf ws.Cells(cell.Row, xy + 1).Value = "" And ws.Cells(cell.Row, xy).Value <> "" And lp = "" Then
                        lp = Format(ws.Cells(k, xy).Value, "m/d")
                        If str = "" Then

                            str = sp & "-" & lp
                            sp = ""
                            lp = ""
                        Else
                            str = str & ", " & sp & "-" & lp
                            sp = ""
                            lp = ""
                        End If
                    End If
                    xy = xy + 1

                Loop


            End If
        Next cell
    Else
        Mlook = "No Match Found"
        Exit Function
    End If

Mlook = str
End Function

Open in new window

EEExample.xlsm
0
 
LVL 30

Expert Comment

by:gowflow
ID: 40627609
ok here is my solution I tried to make it more readable and it is linked to the button Update Schedule in Sheet1 I kept a copy of your original Sheet1 called Sheet1 (2) to compare figures.

here is the code that is in Module1 all you need is to copy this whole Module1 to your production workbook and if you don't want a button just run the macro UpdateSchedules.

Sub UpdateSchedules()
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
Dim MaxRow1 As Long, MaxCol2 As Long, MaxCol3 As Long, I As Long, J As Long
Dim cCell As Range, Rng As Range
Dim sSchedule As String, sFm As String, sTo As String
Dim vRange As Variant

Set WS1 = Sheets("Sheet1")
MaxRow1 = WS1.Range("A" & WS1.Rows.Count).End(xlUp).Row
Set WS2 = Sheets("Sheet2")
MaxCol2 = WS2.Rows(3).End(xlToRight).Column
Set WS3 = Sheets("Sheet3")
MaxCol3 = WS3.Rows(3).End(xlToRight).Column
WS1.Range("B2:B" & MaxRow1).ClearContents

For I = 2 To MaxRow1
    
    '---> Check and gather data from Sheet2
    Set cCell = WS2.Range("A:A").Find(what:=WS1.Cells(I, "A"), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    If Not cCell Is Nothing Then
        Set Rng = WS2.Range(WS2.Cells(cCell.Row, "C"), WS2.Cells(cCell.Row, MaxCol2)).SpecialCells(xlCellTypeConstants)
        If InStr(1, Rng.Address, ",") <> 0 Then
            vRange = Split(Rng.Address, ",")
            For J = LBound(vRange) To UBound(vRange)
                sFm = Mid(vRange(J), 2, 1)
                sTo = Mid(vRange(J), InStr(1, vRange(J), ":") + 2, 1)
                If sSchedule <> "" Then sSchedule = sSchedule & ", "
                sSchedule = sSchedule & Format(WS2.Cells(3, sFm), "Mmm dd") & " - " & Format(WS2.Cells(3, sTo), "Mmm dd")
            Next J
        Else
            vRange = Rng.Address
            sFm = Mid(vRange, 2, 1)
            sTo = Mid(vRange, InStr(1, vRange, ":") + 2, 1)
            If sSchedule <> "" Then sSchedule = sSchedule & ", "
            sSchedule = sSchedule & Format(WS2.Cells(3, sFm), "Mmm dd") & " - " & Format(WS2.Cells(3, sTo), "Mmm dd")
        End If

    End If
    
    '---> Check and gather data from Sheet3
    Set cCell = WS3.Range("A:A").Find(what:=WS1.Cells(I, "A"), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
    If Not cCell Is Nothing Then
        Set Rng = WS3.Range(WS3.Cells(cCell.Row, "C"), WS3.Cells(cCell.Row, MaxCol3)).SpecialCells(xlCellTypeConstants)
        If InStr(1, Rng.Address, ",") <> 0 Then
            vRange = Split(Rng.Address, ",")
            For J = LBound(vRange) To UBound(vRange)
                sFm = Mid(vRange(J), 2, 1)
                sTo = Mid(vRange(J), InStr(1, vRange(J), ":") + 2, 1)
                If sSchedule <> "" Then sSchedule = sSchedule & ", "
                sSchedule = sSchedule & Format(WS3.Cells(3, sFm), "Mmm dd") & " - " & Format(WS3.Cells(3, sTo), "Mmm dd")
            Next J
        Else
            vRange = Rng.Address
            sFm = Mid(vRange, 2, 1)
            sTo = Mid(vRange, InStr(1, vRange, ":") + 2, 1)
            If sSchedule <> "" Then sSchedule = sSchedule & ", "
            sSchedule = sSchedule & Format(WS3.Cells(3, sFm), "Mmm dd") & " - " & Format(WS3.Cells(3, sTo), "Mmm dd")
        End If

    End If
    
    '---> Apply Results
    WS1.Cells(I, "B") = sSchedule
    
    
    '---> Initialise Variables
    sSchedule = ""
    sFm = ""
    sTo = ""
    vRange = vbEmpty
Next I

WS1.Range("B:B").EntireColumn.AutoFit
MsgBox "Schedules Updated.", vbExclamation
End Sub

Open in new window



All is in the attached workbook.
gowflow
EEExample-V01.xlsm
0
 

Author Comment

by:portillosjohn
ID: 40631165
Goflow this looks great. Is there a way to expand this to 9 tabs instead of the 2 tabs?
0
 
LVL 59

Expert Comment

by:Saurabh Singh Teotia
ID: 40631372
Their you go.. I changed the formula..it will now automatically pick from all the worksheets of your data...

Just apply this formula and it will consolidate from all the worksheets...

Function Mlook(r As Range, rn As Range, k As Long, z As Long)

    Dim cell As Range, rd As String, rng As Range
    Dim lc As Long, ws As Worksheet, ws1 As Worksheet, rk As Range
    Dim xy As Long, sp As String, lp As String, str As String
rd = rn.Address
    Set ws1 = Sheets(r.Parent.Name)

    For Each ws In ActiveWorkbook.Worksheets
        If ws.Name <> ws1.Name Then
            Set rng = ws.Range(rd)



            lc = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column


            ' On Error Resume Next
            If Application.WorksheetFunction.CountIf(rng, r.Value) > 0 Then
                For Each cell In rng
                    If cell.Value = r.Value Then

                        xy = z

                        Do Until xy > lc
                            If ws.Cells(cell.Row, xy).Value <> "" And sp = "" Then
                                sp = Format(ws.Cells(k, xy).Value, "m/d")
                            ElseIf ws.Cells(cell.Row, xy + 1).Value = "" And ws.Cells(cell.Row, xy).Value <> "" And lp = "" Then
                                lp = Format(ws.Cells(k, xy).Value, "m/d")
                                If str = "" Then

                                    str = sp & "-" & lp
                                    sp = ""
                                    lp = ""
                                Else
                                    str = str & ", " & sp & "-" & lp
                                    sp = ""
                                    lp = ""
                                End If
                            End If
                            xy = xy + 1

                        Loop


                    End If
                Next cell
      
            End If
        End If

    Next ws

    Mlook = str
End Function

Open in new window




Saurabh...
EEExample.xlsm
0
 
LVL 30

Expert Comment

by:gowflow
ID: 40631807
Here it is for all the sheets that you want.

Sub UpdateSchedules()
Dim WS As Worksheet
Dim WS1 As Worksheet
Dim WS2 As Worksheet
Dim WS3 As Worksheet
Dim MaxRow1 As Long, MaxCol As Long, I As Long, J As Long
Dim cCell As Range, Rng As Range
Dim sSchedule As String, sFm As String, sTo As String
Dim vRange As Variant

Set WS1 = Sheets("Sheet1")
MaxRow1 = WS1.Range("A" & WS1.Rows.Count).End(xlUp).Row
WS1.Range("B2:B" & MaxRow1).ClearContents

For I = 2 To MaxRow1
    For Each WS In ActiveWorkbook.Worksheets
        If WS.Name <> "Sheet1" Then
            MaxCol = WS.Rows(3).End(xlToRight).Column
            '---> Check and gather data from seelct sheet
            Set cCell = WS.Range("A:A").Find(what:=WS1.Cells(I, "A"), LookIn:=xlValues, lookat:=xlWhole, MatchCase:=False)
            If Not cCell Is Nothing Then
                Set Rng = WS.Range(WS.Cells(cCell.Row, "C"), WS.Cells(cCell.Row, MaxCol)).SpecialCells(xlCellTypeConstants)
                If InStr(1, Rng.Address, ",") <> 0 Then
                    vRange = Split(Rng.Address, ",")
                    For J = LBound(vRange) To UBound(vRange)
                        sFm = Mid(vRange(J), 2, 1)
                        sTo = Mid(vRange(J), InStr(1, vRange(J), ":") + 2, 1)
                        If sSchedule <> "" Then sSchedule = sSchedule & ", "
                        sSchedule = sSchedule & Format(WS.Cells(3, sFm), "Mmm dd") & " - " & Format(WS.Cells(3, sTo), "Mmm dd")
                    Next J
                Else
                    vRange = Rng.Address
                    sFm = Mid(vRange, 2, 1)
                    sTo = Mid(vRange, InStr(1, vRange, ":") + 2, 1)
                    If sSchedule <> "" Then sSchedule = sSchedule & ", "
                    sSchedule = sSchedule & Format(WS.Cells(3, sFm), "Mmm dd") & " - " & Format(WS.Cells(3, sTo), "Mmm dd")
                End If
            End If
        End If
    Next WS
    
    
    '---> Apply Results
    WS1.Cells(I, "B") = sSchedule
    
    
    '---> Initialise Variables
    sSchedule = ""
    sFm = ""
    sTo = ""
    vRange = vbEmpty
Next I

WS1.Range("B:B").EntireColumn.AutoFit
MsgBox "Schedules Updated.", vbExclamation
End Sub

Open in new window



File attached.
gowflow
EEExample-V02.xlsm
0
 

Author Comment

by:portillosjohn
ID: 40645406
Awsome gowflow. Last question. Is there a out if a tab is blank or not filled out yet. For "Rng" is nothing?
0
 
LVL 30

Expert Comment

by:gowflow
ID: 40645447
Actually the out is the line before Rng and is the test on cCell is nothing this is the out.

But

I tested it with a blank sheet and with a sheet that had only the header and results are fine no error.

Did you get an error ? if yes then what did you have that generated the error and which one ?

gowflow
0
 
LVL 59

Expert Comment

by:Saurabh Singh Teotia
ID: 40645450
By any chance did you got an opportunity to look at the file which i uploaded..As it gives you the same result by just applying the formula...

Again it will collate data from all of your worksheets into one no matter how many you add..
0
 

Author Comment

by:portillosjohn
ID: 40645502
I It looks like we get an error if the manager column is filled out but no shifts are scheduled.
0
 
LVL 30

Accepted Solution

by:
gowflow earned 500 total points
ID: 40646399
Yes you are entirely correct here is the fix.
gowlfow
EEExample-V03.xlsm
0
 

Author Closing Comment

by:portillosjohn
ID: 40661114
Perfect.
0

Featured Post

Free Tool: Port Scanner

Check which ports are open to the outside world. Helps make sure that your firewall rules are working as intended.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial demonstrates using Microsoft Excel pivot tables, how to reverse engineer competitors' marketing strategies through backlinks.
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa‚Ķ

705 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question