PDA

View Full Version : [SOLVED] Grab data between two dates using arrays



YasserKhalil
01-25-2017, 11:31 PM
Hello everyone
I have three sheets (Sheet1 - Sheet2 - Sheet3) which have some tables (not real tables in excel) ..
These tables have the same structure but non-adjacent
In sheet result, I need to search between two dates (From & To) and grab data from these sheets
I would like to use arrays if possible
Thanks advanced for help

MickG
01-26-2017, 04:58 AM
Try this:-


Sub GetShts()
Dim Ws As Variant, n As Long, c As Long
Dim Rng As Range, Dn As Range, R As Range
Dim St As Date, nD As Date, Ac As Long
Dim Ray()
With Sheets("Result")
St = .Range("A2"): nD = .Range("B2")
For Each Ws In Array("Sheet1", "Sheet2", "Sheet3")
Set Rng = Sheets(Ws).Range("A:A").SpecialCells(xlCellTypeConstants)
For Each Dn In Rng.Areas
n = 0
For Each R In Dn
n = n + 1
If n > 3 And R >= St And R <= nD Then
c = c + 1
ReDim Preserve Ray(1 To 5, 1 To c)
For Ac = 1 To 5
If Ac = 1 Then
Ray(Ac, c) = CDbl(DateValue(R(, Ac)))
Else
Ray(Ac, c) = R(, Ac)
End If
Next Ac
End If
Next R
Next Dn
Next Ws
.Range("A4").Resize(c, 5).Value = Application.Transpose(Ray)
.Range("A:A").NumberFormat = "dd/mm/yyyy"
End With
End Sub

Regards Mick

snb
01-26-2017, 05:44 AM
Sub M_snb()
sn = Sheets("result").Range("A2:B2")

For Each it In Sheets
If it.Name <> "Result" Then
it.Cells.UnMerge
With it.UsedRange
.AutoFilter 1, ">=" & sn(1, 1), xlAnd, "<=" & sn(1, 2)
.Offset(1).Copy Sheets("result").Cells(Rows.Count, 1).End(xlUp).Offset(1)
.AutoFilter
End With
End If
Next
End Sub

or


Sub M_snb()
sn = Sheets("result").Range("A2:B2")

With CreateObject("scripting.dictionary")
For Each it In Sheets
If it.Name <> "Result" Then
it.Cells.UnMerge
sp = it.UsedRange
For j = 1 To UBound(sp)
If IsDate(sp(j, 1)) And sp(j, 1) >= sn(1, 1) And sp(j, 1) <= sn(1, 2) And sp(j, 3) <> "Address"" Then .Item(.Count) = Application.Index(sp, j)
Next
End If
Next

Sheets("result").Cells(4, 1).Resize(.Count, 5) = Application.Index(.items, 0, 0)
End With
End Sub

YasserKhalil
01-26-2017, 06:48 AM
Thanks a lot for great solutions.
As for the structure is changed in case of testing your codes Mr. snb and I need to keep the strucutre. In addition, there are undesired results which contains Address ..
@Mr. Mick
That's great and working well. Just need one modification, in column B in results I don't need statements but I need the name related .. For example, Name1 / Name2 and so on
Thanks a lot for great efforts

MickG
01-26-2017, 08:12 AM
Perhaps:-


Sub nShts()
Dim Ws As Variant, c As Long, Rng As Range, Dn As Range, R As Range
Dim St As Date, nD As Date, Ac As Long, Ray()
With Sheets("Result")
St = .Range("A2"): nD = .Range("B2")
For Each Ws In Array("Sheet1", "Sheet2", "Sheet3")
With Sheets(Ws)
Set Rng = .Range(.Range("A1"), .Range("A" & Rows.Count).End(xlUp))
For Each Dn In Rng
If IsDate(Dn.Value) And Dn.Value >= St And Dn.Value <= nD Then
c = c + 1
ReDim Preserve Ray(1 To 5, 1 To c)
For Ac = 1 To 5
If Ac = 1 Then
Ray(Ac, c) = CDbl(DateValue(Dn(, Ac)))
Else
Ray(Ac, c) = Dn(, Ac)
End If
Next Ac
End If
Next Dn
End With
Next Ws
.Range("A4").Resize(c, 5).Value = Application.Transpose(Ray)
.Range("A:A").NumberFormat = "dd/mm/yyyy"
End With
End Sub

YasserKhalil
01-26-2017, 09:55 AM
I am so sorry Mr. Mick for this confusion. I am really sorry
I mean in column B would contain the names only (Name1 to Name6 according to the sample) .. No statements !!
That's considered as title of each table (these names .. for example : B12 & B16 in sheet1)
Hope there is no confusion now
Thanks a lot for great help and sorry again

p45cal
01-26-2017, 09:56 AM
or perhaps with tweaks to MickG's?:
Sub GetShts()
Dim Ws As Variant, n As Long, c As Long
Dim Rng As Range, Dn As Range, R As Range
Dim St As Date, nD As Date, Ac As Long
Dim Ray()
With Sheets("Result")
St = .Range("A2"): nD = .Range("B2")
For Each Ws In Array("Sheet1", "Sheet2", "Sheet3")
Set Rng = Sheets(Ws).Range("A:A").SpecialCells(xlCellTypeConstants)
For Each Dn In Rng.Areas
n = 0
For Each R In Dn
n = n + 1
If R.Value = "Date" Then myName = R.Offset(-2, 1).Value '<< tweak
If n > 3 And R >= St And R <= nD Then
c = c + 1
ReDim Preserve Ray(1 To 5, 1 To c)
For Ac = 1 To 5
Select Case Ac '<< tweak (Select Case instead of If Then)
Case 1: Ray(Ac, c) = CDbl(DateValue(R(, Ac)))
Case 2: Ray(Ac, c) = myName '<< tweak
Case Else: Ray(Ac, c) = R(, Ac)
End Select
Next Ac
End If
Next R
Next Dn
Next Ws
.Range("A4").Resize(c, 5).Value = Application.Transpose(Ray)
.Range("A4").Resize(c).NumberFormat = "dd/mm/yyyy" '<< tweak
End With
End Sub


Also, be aware that previous longer results will not be deleted by this; you may want to ensure that the Result sheet is cleared of old data before you write fresh data to it.

YasserKhalil
01-26-2017, 11:23 AM
Thanks a lot for great help. That's do the trick
Thank you very much for all of you fantastic gurus
Best and kind regards