Copying over whole rows when criteria over 2 columns is true

[kesh321]

Hello,

I've got a problem which I've tried solving with VBA, but have no idea how to tackle it.
Basically, I've got date column, value column and identificator column.

I need to find matches for 3 criteria:
2 dates i enter into specific cells (from - to) and identificators, which are constant strings (like OVP1, UNP1 - but doesnt matter because if there's no identificator in that row , i do not need it)

I would like to copy over whole rows with matching values to the other tab, each row in the last empty cell.
Data looks something like this:

tab "ALL"

date	value	ID
01/01/2018	VALUE1	OVP1
02/01/2018	VALUE2
02/01/2018	VALUE3	UNP1
03/01/2018	VALUE4
05/01/2018	VALUE5	ADM1

<tbody>
</tbody>

So based on dates in cell A1 (from) and B1 (to), this would copy into the other tab, only rows with VALUE1, VALUE3

The other tab "VBA" would look like this after code execution:
A1= 01/01/2018 , B1= 03/01/2018

date	value	ID
01/01/2018	VALUE1	OVP1
02/01/2018	VALUE3	UNP1

<tbody>
</tbody>

So only 2 rows with values matching would be copied over to "VBA" from "ALL" sheet. This depends on dates I input in A1, B1 sheet "VBA".

Im sure there has to be a loop and something like index/match?

Never done something like this in VBA before, any ideas how to handle this problem??

Thanks,
Matt.

 

[kesh321]

Thanks for that Fluff.

So here's what happens when I run the macro beetwen dates 01/06/2018 - 20/06/2018:
First of all, box telling me "nothing found" comes up.
Then I get values for dates in between 12/06 to 14/06.

I don't know if I am doing something wrong.

Here's my current code for that:

Sub Fltrcopy()Dim Ws1 As Worksheet, Ws2 As Worksheet
   Application.ScreenUpdating = False
   Set Ws1 = Sheets("ALL")
   Set Ws2 = Sheets("VBA")
   With Ws1.ListObjects("Table1").Range
      .AutoFilter 3, ">=" & CLng(Ws2.Range("A2").Value), xlAnd, "<=" & CLng(Ws2.Range("B2").Value)
      .AutoFilter 20, "<>"
      On Error GoTo NoBlanks
      .SpecialCells(xlVisible).Offset(1, 0).Copy Ws2.Range("D2")
      On Error GoTo 0
    Ws1.ShowAllData
   End With
   Ws2.Rows("1:1000").RowHeight = 15


NoBlanks:
   MsgBox "Nothing found"
 On Error Resume Next
End Sub

 

[Fluff]

Are all the dates in the table real dates?

 

[kesh321]

Yes, everything formatted as dates.
Changes to numbers when formatted as text tho , could this be the reason? But then again some of them get copied across so I dont get it

 

[Fluff]

Dates are infact just numbers that are formatted to look like a date. 1st Jan 1900 is 1 2nd is 2 & so-on, making today is 43280.
Is your regional setting dd/mm/yyyy?

 

[kesh321]

Yes, it is. That's weird tho, looks like excel sees it as mm/dd/yyyy, right ? But even thou it would bring out more results, so I am not quite sure. Is everything OK with the code?

 

[Fluff]

The code's working fine for me, so don't think there's a problem there. That said dates can be a pita, especially if your not US based.

 

[kesh321]

Thanks for all Your help Fluff.
If the code is correct I will have to mess around with different sheets.

I will try switching to US dates and see then.

 

[kesh321]

Hey,

Got it almost sorted!

I had to use DateValue, that helps, now I get more results and almost correct date range.

But Still I am getting only about 50% of results, and not all the dates, for example my start date is 01/06 but the oldest entry I get is 04/06.

Please see the code below, in case anyone needs it:

Sub Fltrcopy()

Dim Ws1 As Worksheet, Ws2 As Worksheet
    Dim lDateFrom As Long
    Dim lDateTo As Long
   Application.ScreenUpdating = False
   Application.CopyObjectsWithCells = False ' i do not want to copy objects
   Set Ws1 = Sheets("ALL")
   Set Ws2 = Sheets("VBA")
   With Ws2
   lDateFrom = DateValue(Range("A2")) 'my dates
   lDateTo = DateValue(Range("B2"))
   End With
   With Ws1.Range("A1:AC10000") ' got rid of the table, just using autofilters now
      .AutoFilter 12, ">=" & lDateFrom, xlAnd, "<=" & lDateTo
      .AutoFilter 29, "<>"
      .SpecialCells(xlVisible).Offset(, 9).Copy Ws2.Range("D1")
     On Error GoTo 0
     End With
    Ws1.ShowAllData
   Ws2.Rows("1:1000").RowHeight = 15
   Ws2.Columns("D").ColumnWidth = 3.29
   Ws2.Columns("E").ColumnWidth = 11.14
   Ws2.Columns("F").ColumnWidth = 10
   Ws2.Columns("G").ColumnWidth = 29.14
   Ws2.Columns("H").ColumnWidth = 21.57
   Ws2.Columns("I").ColumnWidth = 9
   Ws2.Columns("J").ColumnWidth = 10
   Ws2.Columns("K").ColumnWidth = 13
   Ws2.Columns("L").ColumnWidth = 85
   Ws2.Columns("M").ColumnWidth = 4.71
   Ws2.Columns("N").ColumnWidth = 7.57
   Ws2.Columns("O").ColumnWidth = 8
   Ws2.Columns("P").ColumnWidth = 10.14
   Ws2.Columns("Q").ColumnWidth = 15.29
   Ws2.Columns("R").ColumnWidth = 31.71
   Ws2.Columns("S").ColumnWidth = 8.5
   Ws2.Columns("T").ColumnWidth = 90
   Ws2.Columns("U").ColumnWidth = 10
   Ws2.Columns("V").ColumnWidth = 20
   Ws2.Columns("W").ColumnWidth = 10.5
   
   ' /\ all that to make sure my columns are properly wide
   Application.CopyObjectsWithCells = True


End Sub

Any ideas ?

 

[kesh321]

My bad, the code is correct now as it is, the results are correct.
'DateValue' sorted it.

I forgot about filtering column 29 as well so I was expecting more results :P

Thanks for all the help Fluff, once again, please consider this solved.

 

[Fluff]

Glad you got it sorted & thanks for the feedback