Solved

Lookup Date Ranges In Excel

Posted on 2015-02-23
15
58 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
  • 6
  • 6
  • 3
15 Comments
 
LVL 29

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 29

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
 

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 29

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
Enabling OSINT in Activity Based Intelligence

Activity based intelligence (ABI) requires access to all available sources of data. Recorded Future allows analysts to observe structured data on the open, deep, and dark web.

 
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 29

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 29

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 29

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

IT, Stop Being Called Into Every Meeting

Highfive is so simple that setting up every meeting room takes just minutes and every employee will be able to start or join a call from any room with ease. Never be called into a meeting just to get it started again. This is how video conferencing should work!

Join & Write a Comment

Approximate matching with VLOOKUP and MATCH seems to me to be a greatly under-used technique, and one which is vital for getting good performance out of large lookups. Until recently I would always have advised using an exact match for simplicity an…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
This Micro Tutorial demonstrates how to create Excel charts: column, area, line, bar, and scatter charts. Formatting tips are provided as well.
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

746 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

Need Help in Real-Time?

Connect with top rated Experts

12 Experts available now in Live!

Get 1:1 Help Now