Improve company productivity with a Business Account.Sign Up

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 91
  • Last Modified:

Lookup Date Ranges In Excel

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
portillosjohn
Asked:
portillosjohn
  • 6
  • 6
  • 3
1 Solution
 
gowflowCommented:
I would like a formula ....

Do you accept a VBA solution ?

gowflow
0
 
portillosjohnAuthor Commented:
Sure if it simple enough for me to implement.
0
 
gowflowCommented:
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
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

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.

 
portillosjohnAuthor Commented:
You can use the example and I should be able to adapt it.
0
 
Saurabh Singh TeotiaCommented:
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
 
gowflowCommented:
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
 
portillosjohnAuthor Commented:
Goflow this looks great. Is there a way to expand this to 9 tabs instead of the 2 tabs?
0
 
Saurabh Singh TeotiaCommented:
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
 
gowflowCommented:
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
 
portillosjohnAuthor Commented:
Awsome gowflow. Last question. Is there a out if a tab is blank or not filled out yet. For "Rng" is nothing?
0
 
gowflowCommented:
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
 
Saurabh Singh TeotiaCommented:
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
 
portillosjohnAuthor Commented:
I It looks like we get an error if the manager column is filled out but no shifts are scheduled.
0
 
gowflowCommented:
Yes you are entirely correct here is the fix.
gowlfow
EEExample-V03.xlsm
0
 
portillosjohnAuthor Commented:
Perfect.
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

Join & Write a Comment

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

  • 6
  • 6
  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now