Vlookup Between Two Dates From a Range of Dates

B

baker_89

New Member
Joined
Aug 25, 2014
Messages
42
I have a data column on a tab [Data] with date/times listed in column A that I need to compare with a range of dates & times on tab [Home] and return the text to the left of the dates if the time is between them. I am having issues with the range of dates on [Home] throwing it off, I have done this kind of thing with a single cell but not a range of cells like I have now. A step further is if the first word on [Data] in column B matches "Line1" it needs to compare dates form a certain range of cells and if "Line2" than another. Want to return say the day of the week into Column E, to show what "Sales Date" that line item was from instead of actual time.

Any help would be GREATLY appreciated!

WasteData.xlsm
ABC
10Line1
11mm/dd/yyyy hh:mmmm/dd/yyyy hh:mm
12Sales DateStartFinish
13Thursday7/6/2020 8:39
14Friday
15Saturday
16Monday7/3/2020 23:477/3/2020 3:02
17Tuesday7/3/2020 3:137/4/2020 5:45
18
19Line2
20mm/dd/yyyy hh:mmmm/dd/yyyy hh:mm
21Sales DateStartFinish
22Thursday7/6/2020 10:58
23Friday
24Saturday
25Monday7/1/2020 8:487/2/2020 4:16
26Tuesday7/2/2020 4:257/2/2020 7:45
Home



WasteData.xlsm
ABCDE
1Date/TimeLocationWeight (Lbs)Sales Date
27/4/2020 0:02Line1 Mixer200
37/4/2020 0:03Line1 Mixer167
47/4/2020 3:08Line1 Proofbox604
57/4/2020 3:10Line1 Oven484
67/4/2020 3:18Line1 Wrap 1375
77/4/2020 3:18Line1 Wrap 2431
87/4/2020 3:19Line1 Destroy149
97/4/2020 3:20Line1 Destroy326
107/4/2020 3:38Line1 Wrap 2275
117/4/2020 4:07Line2 Wrap 1141
127/4/2020 4:11Line2 Wrap 2321
137/4/2020 4:12Line2 Wrap 2360
147/4/2020 4:13Line1 Mixer299
Data


I should add that sheet [Data] and other tabs is pulled and created from a text file via a hefty macro.






VBA Code: 
Sub wastereport()

'***********************Force reset***********************

For Each sh In Worksheets
    If sh.Name Like "Data" Then
        Sheets("Home").Activate
        MsgBox "Please reset data"
        Exit Sub
    End If
Next
'*********************************************************

'*********************Retreive Data from .txt*************

Dim FileNum As Integer
Dim DataLine As String


mypath = Application.ActiveWorkbook.Path 'Path for datafile
filename = mypath & "\" & "WasteData.txt"
FileNum = FreeFile()
Open filename For Input As #FileNum

Worksheets.Add(After:=Worksheets(1)).Name = "Data"

counter = 2

While Not EOF(FileNum)
    Line Input #FileNum, DataLine ' read in data 1 line at a time
    Cells(counter, 1) = DataLine
    counter = counter + 1
Wend

Close #FileNum

Selection = Range("A1").Select

Range(Selection, Selection.End(xlDown)).Select

Selection.TextToColumns DataType:=xlDelimited, _
ConsecutiveDelimiter:=False, Comma:=True

'*******************************************************************

'***************************Select data from dates******************

startdate = Sheets("Home").Cells(3, 2)
enddate = Sheets("Home").Cells(3, 4)


lastweight = Range("C65536").End(xlUp).Row  'find last row
deletecount = 0

For i = 2 To lastweight
    If Cells(i, 1) < startdate Then
        deletecount = deletecount + 1
    End If
Next
If deletecount > 0 Then
    Range(Cells(2, 1), Cells(deletecount + 1, 14)).Select
    Selection.Delete shift:=xlUp
End If

deletecount2 = 0
lastweight = Range("C65536").End(xlUp).Row  'find last row

For i = 2 To lastweight
    If Cells(i, 1) > enddate Then
        deletecount2 = deletecount2 + 1
    End If
Next

If deletecount2 > 0 Then
    Range(Cells(lastweight - deletecount2 + 1, 1), Cells(lastweight, 14)).Select
    Selection.Delete shift:=xlUp
End If
''*****************************************************************************
''************************Clean up data and add headings*************


lastweight = Range("C65536").End(xlUp).Row  'find last row

For i = 2 To lastweight
    Cells(i, 3) = Trim(Cells(i, 3))
    Cells(i, 3) = Replace(Cells(i, 3), "[", "")
    Cells(i, 3) = Replace(Cells(i, 3), "]", "")
    Cells(i, 2) = Trim(Cells(i, 2))
Next

For i = lastweight To 2 Step -1
    If Cells(i, 3) < 200 Then
        Cells(i, 3).EntireRow.Delete
    End If
Next

lastweight = Range("C65536").End(xlUp).Row  'find last row

For i = 2 To lastweight
    Cells(i, 3) = Cells(i, 3) - 200 'Trim 200lbs to tare out dumpster weight
Next


Cells(1, 1) = "Date/Time": Cells(1, 2) = "Location": Cells(1, 3) = "Weight (Lbs)"


''*******************************Collect groups********************************

Dim Locations(0 To 16) As String
Dim Lines(0 To 1) As String
Dim Locationweights(0 To 16) As Double
Dim Lineweights(0 To 1) As Double


Locations(0) = "Bread Mixer": Locations(1) = "Bread Divider": Locations(2) = "Bread Proofbox": Locations(3) = "Bread Oven"
Locations(4) = "Bread Wrap 1": Locations(5) = "Bread Wrap 2": Locations(6) = "Bread Wrap 3": Locations(7) = "Buns Eagle / Pan-O-Mat"
Locations(8) = "Buns Proofbox": Locations(9) = "Buns Oven": Locations(10) = "Buns Cooler": Locations(11) = "Buns Wrap 1"
Locations(12) = "Buns Wrap 2": Locations(13) = "Buns Bulk Packer": Locations(14) = "Bread Destroy": Locations(15) = "Buns Destroy"
Locations(16) = "Bread Crumbs"

Lines(0) = "Bread": Lines(1) = "Buns"

For j = 0 To 16
    For i = 2 To lastweight
        If Cells(i, 2) = Locations(j) Then
            Locationweights(j) = Locationweights(j) + Cells(i, 3)
        End If
    Next
Next

For i = 0 To 6
    Lineweights(0) = Lineweights(0) + Locationweights(i)
    Lineweights(1) = Lineweights(1) + Locationweights(i + 7)
Next

Lineweights(0) = Lineweights(0) + Locationweights(14) + Locationweights(16)
Lineweights(1) = Lineweights(1) + Locationweights(15)

firstday = DateValue(Month(Cells(2, 1)) & "/" & Day(Cells(2, 1)) & "/" & Year(Cells(2, 1)))
lastday = DateValue(Month(Cells(lastweight, 1)) & "/" & Day(Cells(lastweight, 1)) & "/" & Year(Cells(lastweight, 1)))

numdays = lastday - firstday
ReDim days(0 To numdays) As String
ReDim dayweights(0 To numdays) As Single
For i = 0 To numdays
    days(i) = firstday + i
Next


ReDim bunsdays(0 To numdays) As String
ReDim breaddays(0 To numdays) As String
ReDim bunsdayweights(0 To numdays) As Double
ReDim breaddayweights(0 To numdays) As Double


For i = 0 To numdays
    For j = 2 To lastweight
        If DateValue(Month(Cells(j, 1)) & "/" & Day(Cells(j, 1)) & "/" & Year(Cells(j, 1))) = days(i) Then
            If Cells(j, 2) = Locations(0) Or Cells(j, 2) = Locations(1) Or Cells(j, 2) = Locations(2) Or Cells(j, 2) = Locations(3) Or Cells(j, 2) = Locations(4) Or Cells(j, 2) = Locations(5) Or Cells(j, 2) = Locations(6) Or Cells(j, 2) = Locations(14) Or Cells(j, 2) = Locations(16) Then
                breaddayweights(i) = breaddayweights(i) + Cells(j, 3)
            ElseIf Cells(j, 2) = Locations(7) Or Cells(j, 2) = Locations(8) Or Cells(j, 2) = Locations(9) Or Cells(j, 2) = Locations(10) Or Cells(j, 2) = Locations(11) Or Cells(j, 2) = Locations(12) Or Cells(j, 2) = Locations(13) Or Cells(j, 2) = Locations(15) Then
                bunsdayweights(i) = bunsdayweights(i) + Cells(j, 3)
            End If
        End If
    Next
Next

Dim Breadwrap(0 To 5) As String
Dim Breadwrapweight(0 To 5) As Double

Breadwrap(0) = "Bread Wrap 1": Breadwrap(1) = "Bread Wrap 2": Breadwrap(2) = "Bread Wrap 3"
Breadwrap(3) = "Bread Wrap 1": Breadwrap(4) = "Bread Wrap 2": Breadwrap(5) = "Bread Wrap 3"

For i = 0 To 2
    For j = 2 To lastweight
        If Hour(Cells(j, 1)) >= 8 And Hour(Cells(j, 1)) < 16 Then
            If Cells(j, 2) = Breadwrap(i) Then
                Breadwrapweight(i) = Breadwrapweight(i) + Cells(j, 3)
            End If
        ElseIf Hour(Cells(j, 1)) < 8 Or Hour(Cells(j, 1)) >= 16 Then
            If Cells(j, 2) = Breadwrap(i) Then
                Breadwrapweight(i + 3) = Breadwrapweight(i + 3) + Cells(j, 3)
            End If
        End If
    Next
Next




'*****************************************************************************************

'***************************Write to sheet "Tables"***************************************
Worksheets.Add(After:=Worksheets(2)).Name = "Tables"

Cells(1, 1) = "By Line": Cells(2, 1) = "Line": Cells(2, 2) = "Weight (lbs)"
Cells(3, 1) = Lines(0): Cells(4, 1) = Lines(1): Cells(3, 2) = Lineweights(0): Cells(4, 2) = Lineweights(1)
Cells(5, 1) = "Total": Cells(5, 2) = Application.Sum(Range(Cells(3, 2), Cells(4, 2)))


Cells(1, 4) = "By Location": Cells(2, 4) = "Location": Cells(2, 5) = "Weight (lbs)"
For i = 0 To 16
    Cells(i + 3, 4) = Locations(i)
    Cells(i + 3, 5) = Locationweights(i)
Next
Cells(20, 4) = "Total": Cells(20, 5) = Application.Sum(Range(Cells(3, 5), Cells(19, 5)))

Cells(1, 7) = "By Day": Cells(2, 7) = "Day": Cells(2, 8) = "Bread (lbs)": Cells(2, 9) = "Buns (lbs)"
For i = 0 To numdays
    Cells(i + 3, 7) = days(i)
    Cells(i + 3, 8) = breaddayweights(i)
    Cells(i + 3, 9) = bunsdayweights(i)
Next
Cells(numdays + 4, 7) = "Total": Cells(2, 10) = "Total": Cells(numdays + 4, 8) = Application.Sum(Range(Cells(3, 8), Cells(numdays + 3, 8)))
Cells(numdays + 4, 9) = Application.Sum(Range(Cells(3, 9), Cells(numdays + 3, 9)))
For i = 0 To numdays + 1
    Cells(i + 3, 10) = Application.Sum(Range(Cells(i + 3, 8), Cells(i + 3, 9)))
Next

Cells(1, 12) = "Bread Wrap by Shift": Cells(3, 12) = "Shift 1": Cells(4, 12) = "Shift 2"
Cells(2, 13) = "Wrapper 1": Cells(2, 14) = "Wrapper 2": Cells(2, 15) = "Wrapper 3"
For i = 0 To 2
    Cells(3, 13 + i) = Breadwrapweight(i)
    Cells(4, 13 + i) = Breadwrapweight(i + 3)
Next
Cells(5, 12) = "Total": Cells(2, 16) = "Total"
For i = 0 To 2
    Cells(5, 13 + i) = Application.Sum(Range(Cells(3, 13 + i), Cells(4, 13 + i)))
    Cells(i + 3, 16) = Application.Sum(Range(Cells(i + 3, 13), Cells(i + 3, 15)))
Next
'***************************************************************************************
'************************Make tables look pretty****************************************

With Range(Cells(1, 1), Cells(1, 4)).Font
    .Bold = True
End With

With Range(Cells(1, 7), Cells(1, 12)).Font
    .Bold = True
End With

With Columns("B")
    .ColumnWidth = .ColumnWidth * 1.5
End With

With Columns("C")
    .ColumnWidth = .ColumnWidth * 0.4
End With

With Columns("D")
    .ColumnWidth = .ColumnWidth * 2
End With

With Columns("E")
    .ColumnWidth = .ColumnWidth * 1.5
End With

With Columns("F")
    .ColumnWidth = .ColumnWidth * 0.4
End With

With Columns("G")
    .ColumnWidth = .ColumnWidth * 2
End With

With Columns("H")
    .ColumnWidth = .ColumnWidth * 1.5
End With

With Columns("I")
    .ColumnWidth = .ColumnWidth * 1.2
End With

With Columns("J")
    .ColumnWidth = .ColumnWidth * 2
End With

With Columns("K")
    .ColumnWidth = .ColumnWidth * 0.4
End With

With Columns("M")
    .ColumnWidth = .ColumnWidth * 1.3
End With

With Columns("N")
    .ColumnWidth = .ColumnWidth * 1.3
End With

With Columns("O")
    .ColumnWidth = .ColumnWidth * 1.3
End With

Range(Cells(2, 1), Cells(4, 2)).Borders.LineStyle = xlContinuous
Range(Cells(2, 4), Cells(19, 5)).Borders.LineStyle = xlContinuous
Range(Cells(2, 7), Cells(numdays + 3, 10)).Borders.LineStyle = xlContinuous
Range(Cells(2, 12), Cells(4, 15)).Borders.LineStyle = xlContinuous

'**************************************************************************
'**********************Charts**********************************************
Worksheets.Add(After:=Worksheets(3)).Name = "Charts"

Dim Chart1 As Chart
Sheets("Tables").Activate
With ActiveSheet
    Set DataRange = .Range(.Cells(3, 1), .Cells(4, 2))
End With
Set Chart1 = Sheets("Charts").Shapes.AddChart(xl3DColumnClustered).Chart
Chart1.SetSourceData Source:=DataRange
With Chart1
    .HasTitle = True
    .ChartTitle.Text = "Waste by Line"
    .HasLegend = False
    .ChartStyle = 2
End With

Dim Chart2 As Chart
Sheets("Tables").Activate
With ActiveSheet
    Set DataRange = .Range(.Cells(3, 4), .Cells(19, 5))
End With
Set Chart2 = Sheets("Charts").Shapes.AddChart(xl3DColumnClustered).Chart
Chart2.SetSourceData Source:=DataRange
With Chart2
    .HasTitle = True
    .ChartTitle.Text = "Waste by Location"
    .HasLegend = False
    .ChartStyle = 2
End With

Dim Chart3 As Chart
Sheets("Tables").Activate
With ActiveSheet
    Set DataRange = .Range(.Cells(2, 7), .Cells(numdays + 3, 9))
End With
Set Chart3 = Sheets("Charts").Shapes.AddChart(xl3DColumnClustered).Chart
Chart3.SetSourceData Source:=DataRange
With Chart3
    .HasTitle = True
    .ChartTitle.Text = "Waste by Day"
    .HasLegend = True
    .ChartStyle = 2
End With

Dim Chart4 As Chart
Sheets("Tables").Activate
With ActiveSheet
    Set DataRange = .Range(.Cells(2, 12), .Cells(4, 15))
End With
Set Chart4 = Sheets("Charts").Shapes.AddChart(xl3DColumnClustered).Chart
Chart4.SetSourceData Source:=DataRange
With Chart4
    .HasTitle = True
    .ChartTitle.Text = "Bread Wrap by Shift and Wrapper"
    .HasLegend = True
    .ChartStyle = 2
End With


Sheets("Charts").Activate
Dim ChtObj As ChartObject
L = 10
T = 10
For Each ChtObj In ActiveSheet.ChartObjects

  ChtObj.Left = L
  ChtObj.Top = T

  L = L + 400
  If L > 500 Then
    L = 10
    T = T + 250
  End If


Next ChtObj
End Sub
 
Last edited by a moderator:

Excel Facts

Did you know Excel offers Filter by Selection?
Add the AutoFilter icon to the Quick Access Toolbar. Select a cell containing Apple, click AutoFilter, and you will get all rows with Apple
Sort by date Sort by votes
baker_89 said:
Want to return say the day of the week into Column E, to show what "Sales Date" that line item was from instead of actual time.
Click to expand...

Try the following formula.

varios 07jul2020.xlsm
ABCDE
1Date/TimeLocationWeight (Lbs)Sales Date
207/04/2020 00:02Line1 Mixer200Tuesday
307/04/2020 00:03Line1 Mixer167Tuesday
407/04/2020 03:08Line1 Proofbox604Tuesday
507/04/2020 03:10Line1 Oven484Tuesday
607/04/2020 03:18Line1 Wrap 1375Tuesday
707/04/2020 03:18Line1 Wrap 2431Tuesday
807/04/2020 03:19Line1 Destroy149Tuesday
907/04/2020 03:20Line1 Destroy326Tuesday
1007/04/2020 03:38Line1 Wrap 2275Tuesday
1107/04/2020 04:07Line2 Wrap 1141dont exists
1207/04/2020 04:11Line2 Wrap 2321dont exists
1307/04/2020 04:12Line2 Wrap 2360dont exists
1407/04/2020 04:13Line1 Mixer299Tuesday
data
Cell Formulas
RangeFormula
E2:E14E2=IFERROR(IF(MID(B2,5,1)="1", INDEX(Home!$A$13:$A$17,SUMPRODUCT((Home!$B$13:$B$17<=A2)*(Home!$C$13:$C$17>=A2)*(ROW(Home!$A$13:$A$17)))-12), INDEX(Home!$A$22:$A$26,SUMPRODUCT((Home!$B$22:$B$26<=A2)*(Home!$C$22:$C$26>=A2)*(ROW(Home!$A$22:$A$26)))-21)),"dont exists")
 
Upvote 0
That worked perfect, Thank you!

Step further, what is the correct syntax to have the macro add that formula in the column next to the data table when the data is pulled in automatically?
I keep getting an error, "Compile Error: Expected: Then or GoTo"


VBA Code: 
lastweight = Range("C65536").End(xlUp).Row

For i = 2 To lastweight
    If Cells(i, 4) = Cells(i, 4).FormulaR1C1 = "=IFERROR(IF(MID(B2,5,1)="1",INDEX(Home!$A$13:$A$17,SUMPRODUCT((Home!$B$13:$B$17<=A2)*(Home!$C$13:$C$17>=A2)*(ROW(Home!$A$13:$A$17)))-12),INDEX(Home!$A$22:$A$26,SUMPRODUCT((Home!$B$22:$B$26<=A2)*(Home!$C$22:$C$26>=A2)*(ROW(Home!$A$22:$A$26)))-21)),"dont exists")"

Next
 
Last edited by a moderator:
Upvote 0
baker_89 said:
If Cells(i, 4) = Cells(i, 4).FormulaR1C1 = "=IFERROR(
Click to expand...

That part of code is not in your original request, so I suppose you should create a new thread.

But I go a little ahead.
You are comparing the cell against the same cell (Cells(i, 4) = Cells(i, 4)) , but you didn't put the Then statement, but I don't understand what you want to do.
 
Upvote 0
You must log in or register to reply here.

Similar threads

I
  • Solved
Listbox on userform to show results in reverse order
2
Replies
16
Views
354
Fuji
F
I
  • Solved
Date formula not applied the same to all Listbox entries
Replies
2
Views
48
ipbr21054
I
C
  • Solved
Sum final column after creating worksheet
Replies
4
Views
100
cdrobinson83
C
N
  • Question Question
AutoFilter Field Macro Returns a Header Row only
2
Replies
11
Views
221
MARK858
MARK858
montecarlo2012
  • Question Question
change display from horizontal to vertical
Replies
2
Views
137
montecarlo2012
montecarlo2012

Forum statistics

Threads
1,224,823
Messages
6,181,181
Members
453,022
Latest member
Mohamed Magdi Tawfiq Emam

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top