Macro or Lookup?

Utradeshow

Well-known Member
Joined
Apr 26, 2004
Messages
769
Hi Guys, I have a workbook on SHEET 1 I have a running database actually a tracking system. It consiststs of COLUMNS "A" through "J"

Colums G through J have dates in them. I am looking to see if I can have sheet 2 have an input cell where I enter the date and it will list the rows containing the dates? Here is an example of the first sheet.
Trio Tracking 2006 Test.xls
ABCDEFGHIJ
212345B.E.CustomerClient01/03/0601/04/0601/07/0601/07/06
3901508B.E.CustomerClient01/03/0601/04/0601/07/0601/07/06
4901509B.E.CustomerClient01/03/0601/04/0601/07/0601/07/06
TRADESHOW
 

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Hi,

seems like you can use autofilter for this

record a macro
filter your sheet to required date
copy the range
paste to sheet2
stop recording

if this works for you
post the code and we will edit it to get it working in all circumstances

kind regards,
Erik
 
Upvote 0
Yes, I think that may work. I recorded Macro What I am trying to do is Have on the SHEET Named "WEEKEND" in say cell A1 enter 9/16 and in cell A2 enter 9/17 and it would place all the corresponding results in say row 5 on down..

Code:
Sub DATEFILTER()
'
' DATEFILTER Macro
' Macro recorded 9/13/2006 by Dan
'

'
    Selection.AutoFilter
    Selection.AutoFilter Field:=7, Criteria1:="09/01/06"
    ActiveWindow.Panes(3).Activate
    Rows("718:723").Select
    Selection.Copy
    Sheets("Weekend").Select
    ActiveSheet.Paste
End Sub
 
Upvote 0
Hi,

first question
did you try to run your recorded code ?
I cannot make autofilter do the job: it filters to nothing (and copies everything instead of the correspontding rows)
I know this is one of ExcelVBA strange things (I prefer the word oddities!!)
possible solution see http://www.mrexcel.com/board2/viewtopic.php?t=162471

let's start with A1 only
put a date in A1 and run the code
it will work perfectly - at least it does for me - when the cells or anything but dates
Code:
Option Explicit

Sub DATEFILTER()
'Erik Van Geit
'060914
Dim TradeSh As Worksheet
Dim WeekendSh As Worksheet
Dim TradeLR As Long
Dim WeekendLR As Long

Set TradeSh = Sheets("TRADESHOW")
Set WeekendSh = Sheets("WEEKEND")

    With WeekendSh
    'if you do NOT want to overwrite items in column A then enable quoted lines
    'On Error Resume Next
    'WeekendLR = .Range("A5:A" & Rows.Count).Find("*", .[A5], xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row
    'On Error Resume Next
    'If WeekendLR = 0 Then WeekendLR = 5
    .Range("A5:J" & Rows.Count).ClearContents
    WeekendLR = 5
    End With

    With TradeSh
    .AutoFilterMode = False
    TradeLR = .Cells.Find("*", .[A1], xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row
    
        With .Range("A1:J1")
        .AutoFilter
        .AutoFilter Field:=7, Criteria1:=WeekendSh.Range("A1")
        .Offset(1, 0).Resize(TradeLR - 1, .Columns.Count).Copy WeekendSh.Range("A5")
        End With
    .AutoFilterMode = False
    End With

End Sub
I'm still hoping it will work for you, perhaps with the "CLng" (see link). If not, I hope someone can jump in, because this time I'm stuck :confused:

kind regards,
Erik

EDIT: called some guys
hopefully Andrew Poulsom will see this one
 
Upvote 0
One thing that was not clear was what column(s) you want to filter for, seeing as there are 4 that have dates in your screen shot (G:J) but in your example macro recorder code you only referenced field #7, inferring you only want to filter for column G.

So assuming...

- Your source sheet tab is named Tradeshow
- Your destination sheet is named Weekend
- In cell A1 of the Weekend sheet is your start from date criteria
- In cell A2 of the Weekend sheet is your end to date criteria
- You want the entire rows from Tradeshow copied to the Weekend sheet starting in row 5
- You only want to filter for dates in column G of Tradeshow

..then this macro will do that.



Sub Test1()
Application.ScreenUpdating = False

Dim LR&, FilterRange As Range
Dim StartDate As Date, EndDate As Date
Dim ClosedWindowStartDate As Date
Dim ClosedWindowEndDate As Date

With Sheets("Weekend")
StartDate = .Range("A1").Value
EndDate = .Range("A2").Value
End With

ClosedWindowStartDate = DateSerial(Year(StartDate), Month(StartDate), Day(StartDate) - 1)
ClosedWindowEndDate = DateSerial(Year(EndDate), Month(EndDate), Day(EndDate) + 1)

With Sheets("Tradeshow")
.AutoFilterMode = False
LR = .Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
Set FilterRange = .Range("G1:G" & LR)

FilterRange.AutoFilter _
Field:=1, Criteria1:=">" & CDbl(ClosedWindowStartDate), _
Operator:=xlAnd, _
Criteria2:="<" & CDbl(ClosedWindowEndDate)

On Error Resume Next
With FilterRange
.Offset(1).Resize(.Rows.Count - 1).SpecialCells(12).EntireRow.Copy Sheets("Weekend").Range("A5")
End With
Err.Clear

Set FilterRange = Nothing
.AutoFilterMode = False
End With

Application.ScreenUpdating = True
End Sub
 
Upvote 0
thanks for the assist, Tom,

My interpretations of the request was, that a match must be found for A1, and then (in next loop) for A2. Anyway, I tried for a looooooooong time to ammend your code & for the life of me cannot figure out to make it work when filtering to a single date (instead of between two dates). Brainproblems or Exceloddity ?

Can you tell us what would be the codeline to filter for a single date ?

kind regards,
Erik
 
Upvote 0
Hi Guy's That is great, Tom's code does pretty much what I was looking for. One question though, on what sheet do I place the code, If I put dates in and manually run it works..

The sheet TRADESHOW is a Tracking sheet for example.

Pickup (Row G) 9/14
Pickup (Row H) 9/15

Deliver (Row I) 9/18
Deliver (Row J) 9/19

What I'm trying to do is Enter 2 dates Say the weekend of 9/16-9/17 Any any shipments that would either Pickup or Deliver on those days would be displayed in the result.

So If a shipment had pickup spread of 9/15-9/16 to deliver 9/20-9/21
It would be displayed

And if a shipment was delivering on say 9/16-9/17 that would also be displayed.

I'm not sure if this is possible but actually any dates in the colums G-J matching the criteria would display.

Thank you Guy's sooo Much
 
Upvote 0
Hi,

that's another story
you could loop and filter for each column
then filter out the uniques (in case several columns of the same row match the criteria)

I prefered this
could take a little longer, but seems easier to understand & to edit
Code:
Option Explicit

Sub DATEFILTER_more_columns()
'Erik Van Geit
'060914
'find in several columns value between startdate & enddate
Dim TradeSh As Worksheet
Dim WeekendSh As Worksheet
Dim TradeLR As Long
Dim WeekendLR As Long
Dim i As Long
Dim c As Range
Dim StartDate As Date
Dim EndDate As Date
Dim FindDate As Date
Dim AppSetCalc As Integer

Set TradeSh = Sheets("TRADESHOW")
Set WeekendSh = Sheets("WEEKEND")

    With WeekendSh
    .Range("A3:J" & Rows.Count).ClearContents
    StartDate = .Range("A1").Value
    StartDate = DateSerial(Year(StartDate), Month(StartDate), Day(StartDate))
    EndDate = .Range("A2").Value
    EndDate = DateSerial(Year(EndDate), Month(EndDate), Day(EndDate))
    End With
    
    With Application
    .ScreenUpdating = False
    AppSetCalc = .Calculation
    .Calculation = xlCalculationManual
    End With

    With TradeSh
    TradeLR = .Cells.Find("*", .[A1], xlFormulas, xlPart, xlByRows, xlPrevious, False, False).Row
        For i = 2 To TradeLR
        Set c = Nothing
            For FindDate = StartDate To EndDate
            Set c = .Range("G" & i & ":J" & i).Find(FindDate)
                If Not c Is Nothing Then
                .Range(.Cells(i, "A"), .Cells(i, "J")).Copy WeekendSh.Cells(Rows.Count, "A").End(xlUp)(2)
                Exit For
                End If
            Next FindDate
        Next i

    End With
    
    With Application
    .ScreenUpdating = True
    .Calculation = AppSetCalc
    End With

End Sub
best regards,
Erik
 
Upvote 0
That seems to do the trick!! I just can't seem to make it run automatically.
Also if it could copy out to column "M" I think it would be perfect..

Thank you So Much again Eric..
 
Upvote 0
this would be an alternative

   G        H       I        J       K  L       M       
 1 header   header  header   header     date1   date2   
 2 1/03/06  1/04/06 1/07/06  1/07/06    2/03/06 4/03/06 
 3 2/03/06  1/04/06 2/07/06  1/07/06 1                  
 4 3/03/06  1/04/06 3/07/06  1/07/06 1                  
 5 1/04/06  1/04/06 4/07/06  1/07/06 0                  
 6 1/04/06  1/04/06 5/07/06  1/07/06 0                  
 7 1/04/06  1/04/06 2/03/06  1/07/06 1                  
 8 1/04/06  1/04/06 7/07/06  1/07/06 0                  
 9 1/04/06  1/04/06 8/07/06  1/07/06 0                  
10 1/04/06  1/04/06 9/07/06  1/07/06 0                  
11 2/03/06  1/04/06 10/07/06 1/07/06 1                  
12 2/03/06  1/04/06 11/07/06 1/07/06 1                  
13 12/03/06 1/04/06 12/07/06 1/07/06 0                  
14 13/03/06 1/04/06 13/07/06 1/07/06 0                  
15 14/03/06 1/04/06 2/03/06  1/07/06 1                  
16 15/03/06 1/04/06 15/07/06 1/07/06 0                  
17 16/03/06 1/04/06 16/07/06 1/07/06 0                  

TRADESHOW

[Table-It] version 06 by Erik Van Geit
Code:
RANGE   FORMULA (1st cell)
K3:K17  =SUMPRODUCT(--(G3:J3>=$L$2),--(G3:J3<=$M$2))

[Table-It] version 06 by Erik Van Geit
now just filter to column K + copy-paste
might be quicker, just posted to get it in mind if any problems
 
Upvote 0

Forum statistics

Threads
1,214,653
Messages
6,120,750
Members
448,989
Latest member
mariah3

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