copy rows if number doesn't exist in all worksheet

[mokie]

Hello, I have some case to solve and I don't have enough experience with vba to do by myself.
That's the point I need to help.
Now I copy all record with requrement to first blank rows. When makro starts again copy the same record by req in the end of the list.

First thing is I need to be sure after copy from sheet(DataBase) that I don't paste the same record again.
I have some requirements to find in WorkSheet(DataBase) from A1 and B1 (text) and E1 and F1 (Date)
(text in column 4, and date in column 11)
In column 2 - I have unique numer for rows.

Many Thanks in advanced:)


Another question?
It it possible to check all worksheets(about 60) in workbook to serach at the same time the same ranges before paste?
Like in example If i tried copy to sheet(Outsheet) before paste form DataBase I'd like to check all worksheet in workbook in the same range (serach for unique number from column 2.)

Below. The file and code.


Sub SearchReq()
Dim tb, arr(), tb_2
Dim i As Long, j As Long, k As Integer, kol As Integer

Dim req1 As Variant, req2 As Variant, req3DateLowL As Variant, req4DateUppL As Variant

With ThisWorkbook.Sheets("DataBase")
req1 = .[A2]
req2 = .[B2]

req3DateLowL = .[E2]
req4DateUppL = .[F2]

With ThisWorkbook.Sheets("OutSheet")
tb_2 = .Range("B2:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
End With




With ThisWorkbook.Sheets("DataBase")
tb = .Range("A5:O" & .Cells(.Rows.Count, 2).End(xlUp).Row)


kol = UBound(tb, 2)


For i = 1 To UBound(tb)

If (tb(i, 4) = req1) And (tb(i, 11) >= req3DateLowL) And (tb(i, 11) <= req4DateUppL) Or ((tb(i, 4) = req2 And (tb(i, 11) >= req3DateLowL And tb(i, 11)) <= req4DateUppL)) Then




j = j + 1


ReDim Preserve arr(1 To kol, 1 To j)
For k = 1 To kol
arr(k, j) = tb(i, k)
Next
End If

Next i



With ThisWorkbook.Sheets("OutSheet").Select
Sheets("OutSheet").Range("A1").End(xlDown).Offset(1, 0).Select
ActiveCell.Resize(UBound(arr, 2), kol) = Application.Transpose(arr)
End With
End With
End With


End Sub

[p45cal]

As a quick and dirty solution, you can use Remove Duplicates on the OutSheet table after you have copied data over to it.
Your macro has some unnecessary code wich I have disabled/removed, and I've added a line to remove duplicates:
Sub SearchReq()
Dim tb, arr() ', tb_2
Dim i As Long, j As Long, k As Integer, kol As Integer
Dim req1 As Variant, req2 As Variant, req3DateLowL As Variant, req4DateUppL As Variant

With ThisWorkbook.Sheets("DataBase")
req1 = .[A2]
req2 = .[B2]
req3DateLowL = .[E2]
req4DateUppL = .[F2]
' With ThisWorkbook.Sheets("OutSheet")
' tb_2 = .Range("B2:B" & .Cells(.Rows.Count, 2).End(xlUp).Row) 'not used anywhere!
' End With
tb = .Range("A5:O" & .Cells(.Rows.Count, 2).End(xlUp).Row)
kol = UBound(tb, 2)
For i = 1 To UBound(tb)
If (tb(i, 4) = req1) And (tb(i, 11) >= req3DateLowL) And (tb(i, 11) <= req4DateUppL) Or ((tb(i, 4) = req2 And (tb(i, 11) >= req3DateLowL And tb(i, 11)) <= req4DateUppL)) Then
j = j + 1
ReDim Preserve arr(1 To kol, 1 To j)
For k = 1 To kol
arr(k, j) = tb(i, k)
Next
End If
Next i
With ThisWorkbook.Sheets("OutSheet")
.Range("A1").End(xlDown).Offset(1).Resize(UBound(arr, 2), kol) = Application.Transpose(arr)
.Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15), Header:=xlYes
'.Range("A1").CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlYes' an alternative if you can depend on column 2
End With
End With
End Sub

BUT, you have a bigger problem, with dates. I'm guessing you're in Europe (as I am) where the dates are more usually expressed as day/month/year and not like in the USA as month/day/year.

when I ran your macro with parameters as you supplied, I noticed the dates on the OutSheet weren't aligned:
18329

and when I change the format to make the month obvious I get:
18332
which means the first date isn't recognised as a date, but worse:

if I look at the DataBase sheet to see where the data has come from:
18331

and making the months obvious:
18330
I see the dates have changed to what's plainly wrong.

The problem arises in this bit of code:
= Application.Transpose(arr)
which unfortunately changes dates to plain strings, which are then put on the sheet and Excel tries to interpret the dates.

We could get round it by converting dates to longs, then changing the format of cells they're placed in, but better not to use Transpose at all and find another way. If speed is not a concern (there won't be much copying to be done) then a plain row by row copy/paste would deal with this problem.

I'll have a think and come back.

As to your other question, it's possible of course to search all the other sheets (do the sheets to be searched follow a tab name convention/system (to avoid searching sheets unnecessarily))?

Again, I'll have a think and come back (I'm thinking along the lines of looping throught the sheets and ensuring that Application.Match(unique no, Sheet.Columns(2),0) always returns an error (=not found))

[p45cal]

Oh, and one more thing to be aware of when posting to sites such as this, have a read of http://www.excelguru.ca/content.php?184
It's a requirement to say where you have posted the same or a very similar question.

[p45cal]

This deals with the dates problem:
Sub SearchReq2()
Dim tb
Dim i As Long, j As Long, k As Long, kol As Long
Dim req1, req2, req3DateLowL, req4DateUppL

With ThisWorkbook.Sheets("DataBase")
req1 = .[A2]
req2 = .[B2]
req3DateLowL = .[E2]
req4DateUppL = .[F2]
tb = .Range("A5:O" & .Cells(.Rows.Count, 2).End(xlUp).Row)
kol = UBound(tb, 2)
For i = 1 To UBound(tb)
If (tb(i, 4) = req1) And (tb(i, 11) >= req3DateLowL) And (tb(i, 11) <= req4DateUppL) Or ((tb(i, 4) = req2 And (tb(i, 11) >= req3DateLowL And tb(i, 11)) <= req4DateUppL)) Then
j = j + 1
For k = 1 To kol
tb(j, k) = tb(i, k)
Next
End If
Next i
With ThisWorkbook.Sheets("OutSheet")
.Range("A1").End(xlDown).Offset(1).Resize(j, kol) = tb
' .Range("A1").CurrentRegion.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15), Header:=xlYes
.Range("A1").CurrentRegion.RemoveDuplicates Columns:=2, Header:=xlYes ' an alternative if you can depend on column 2
End With
End With
End Sub

[p45cal]

This one checks for pre-existing unique number in column 2 of the Outsheet before adding to it.
But it doesn't prevent the copying over of duplicates if they exist in DataBase (you could do a Remove Duplicates to the Database sheet before running the macro (or at the beginnng of the macro)):
Sub SearchReq3()
Dim tb
Dim i As Long, j As Long, k As Long, kol As Long
Dim req1, req2, req3DateLowL, req4DateUppL
Set OutSht = ThisWorkbook.Sheets("OutSheet")
With ThisWorkbook.Sheets("DataBase")
req1 = .[A2]
req2 = .[B2]
req3DateLowL = .[E2]
req4DateUppL = .[F2]
tb = .Range("A5:O" & .Cells(.Rows.Count, 2).End(xlUp).Row)
kol = UBound(tb, 2)
For i = 1 To UBound(tb)
If (tb(i, 4) = req1) And (tb(i, 11) >= req3DateLowL) And (tb(i, 11) <= req4DateUppL) Or ((tb(i, 4) = req2 And (tb(i, 11) >= req3DateLowL And tb(i, 11)) <= req4DateUppL)) Then
If IsError(Application.Match(tb(i, 2), OutSht.Columns(2), 0)) Then
j = j + 1
For k = 1 To kol
tb(j, k) = tb(i, k)
Next
End If
End If
Next i
If j > 0 Then OutSht.Range("A1").End(xlDown).Offset(1).Resize(j, kol) = tb
End With
End Sub

[mokie]

I have no idea why my posted aren't add.
Very Thankfull for Your attention p45cal I'm form Europe:)

Clearly p45ca about results.l. I tested all your solution. Only last (3rd) work better. (But If I don't have any records in OutSheet is an error.)

Elier:
Before in 1st and 2nd somethimes is I have empty spaces in list it was copy smoetimes but not everytime - 1 the same match in 2 rows.


Thanks a lot.
Before I was trying use Match in ISError as You but I was alwayes error2042 in line with transpose 2 arrays (form both sheets).
Probably Your solution it will enough good to implement to my project.
But compare 2 arrays as well I something to I still trying to force and learn how to do at :)

[p45cal]

I have no idea why my posted aren't add.I've no idea what this means.





But If I don't have any records in OutSheet is an error.The same would have happened with your original code. If there's nothing else on the sheet apart from this table then instead of:
If j > 0 Then OutSht.Range("A1").End(xlDown).Offset(1).Resize(j, kol) = tbhave:
If j > 0 Then OutSht.Cells(OutSht.Rows.Count, "A").End(xlUp).Offset(1).Resize(j, kol) = tb





Elier:
Before in 1st and 2nd somethimes is I have empty spaces in list it was copy smoetimes but not everytime - 1 the same match in 2 rows.I'm not sure what this means.





But compare 2 arrays as well I something to I still trying to force and learn how to do at :)nor this!

[mokie]

I've no idea what this means.
I just trying to post on forum to reply after Your solution nr1 nr2 but probably forum is blocked my post.
I'm tested macro SearchReq,SearchReq2 and in result on OutSheet somethimes I paste the same record. Only in Req3 it was alwayes good.

I'm really glad for Your investigation about Date and works on my issue.

so on.
In third Your solution it's works very good. Yes It's my wine from oryginal macro starts with A1. Thank You for improve my bad:)










mookie: But compare 2 arrays as well I something to I still trying to force and learn how to do at :)
P45cal: nor this!
:) It's just my whining after no added post on forum. I writting more about my old solution. Nevermind:)
I am very satisfied with your help and thank you again.

[mokie]

I have one question more. I thing the last one.
Thanks in advanced.

I'd like only transfer to Outsheet not all column but probably only 5 columns like 1,2,3,7,12.
Now i listetd to Ubound(tb) and i need to change declaration of "kol" to Arrays if Am I right.
It's not working - It seems to be something like that below?


Dim kol(1 to 5) as variant
Dim z as integer
For z=1 to 5
kol=Array(1,2,3,7,12)

kol(z)
next z

[p45cal]

try:
Sub SearchReq4()
Dim tb
Dim i As Long, j As Long, k As Long, kol
Dim req1, req2, req3DateLowL, req4DateUppL

kol = Array(1, 2, 3, 7, 12)
Set OutSht = ThisWorkbook.Sheets("OutSheet")
With ThisWorkbook.Sheets("DataBase")
req1 = .[A2]
req2 = .[B2]
req3DateLowL = .[E2]
req4DateUppL = .[F2]
tb = .Range("A5:L" & .Cells(.Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(tb)
If (tb(i, 4) = req1) And (tb(i, 11) >= req3DateLowL) And (tb(i, 11) <= req4DateUppL) Or ((tb(i, 4) = req2 And (tb(i, 11) >= req3DateLowL And tb(i, 11)) <= req4DateUppL)) Then
If IsError(Application.Match(tb(i, 2), OutSht.Columns(2), 0)) Then
j = j + 1
For k = 0 To UBound(kol)
tb(j, k + 1) = tb(i, kol(k))
Next
End If
End If
Next i
If j > 0 Then OutSht.Cells(OutSht.Rows.Count, "A").End(xlUp).Offset(1).Resize(j, UBound(kol) + 1) = tb
End With
End Sub


some changes in red:

Sub SearchReq4()
Dim tb
Dim i As Long, j As Long, k As Long, kol
Dim req1, req2, req3DateLowL, req4DateUppL

kol = Array(1, 2, 3, 7, 12)
Set OutSht = ThisWorkbook.Sheets("OutSheet")
With ThisWorkbook.Sheets("DataBase")
req1 = .[A2]
req2 = .
req3DateLowL = .[E2]
req4DateUppL = .[F2]
tb = .Range("A5:[B]L" & .Cells(.Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(tb)
If (tb(i, 4) = req1) And (tb(i, 11) >= req3DateLowL) And (tb(i, 11) <= req4DateUppL) Or ((tb(i, 4) = req2 And (tb(i, 11) >= req3DateLowL And tb(i, 11)) <= req4DateUppL)) Then
If IsError(Application.Match(tb(i, 2), OutSht.Columns(2), 0)) Then
j = j + 1
For k = 0 To UBound(kol)
tb(j, k + 1) = tb(i, kol(k))
Next
End If
End If
Next i
If j > 0 Then OutSht.Cells(OutSht.Rows.Count, "A").End(xlUp).Offset(1).Resize(j, UBound(kol) + 1) = tb
End With
End Sub

and one deleted line:
kol = UBound(tb, 2)



If you want to "check all worksheets(about 60) in workbook to serach at the same time the same ranges before paste" then answer my question in msg#2:
Do the sheets to be searched follow a tab name convention/system (to avoid searching sheets unnecessarily)?

[mokie]

P45Cal - thanks again:) It's work perfectly. As I came up.
Great to learn with marks on red changes. It's more easier to understand how the code after modificate it works.


If you want to "check all worksheets(about 60) in workbook to serach at the same time the same ranges before paste" then answer my question in msg#2:
Do the sheets to be searched follow a tab name convention/system (to avoid searching sheets unnecessarily)?
No I don't have a key to reject any of worksheets by name. Only recently uses could be help to reject no using sheet for 20 days. But Excel probably doesn't have that solution with Worksheet.

[p45cal]

try:
Sub SearchReq5()
Dim tb, OutSht, IsNowhereElse As Boolean, sht
Dim i As Long, j As Long, k As Long, kol
Dim req1, req2, req3DateLowL, req4DateUppL

kol = Array(1, 2, 3, 7, 12)
Set OutSht = ThisWorkbook.Sheets("OutSheet")
With ThisWorkbook.Sheets("DataBase")
req1 = .[A2]
req2 = .[B2]
req3DateLowL = .[E2]
req4DateUppL = .[F2]
tb = .Range("A5:L" & .Cells(.Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(tb)
If (tb(i, 4) = req1) And (tb(i, 11) >= req3DateLowL) And (tb(i, 11) <= req4DateUppL) Or ((tb(i, 4) = req2 And (tb(i, 11) >= req3DateLowL And tb(i, 11)) <= req4DateUppL)) Then
If IsError(Application.Match(tb(i, 2), OutSht.Columns(2), 0)) Then
'search the other sheets:
IsNowhereElse = True
For Each sht In ThisWorkbook.Sheets
If sht.Name <> "DataBase" Then
If Not IsError(Application.Match(tb(i, 2), sht.Columns(2), 0)) Then
IsNowhereElse = False
Exit For
End If
End If
Next sht
'end search the other sheets.
If IsNowhereElse Then
j = j + 1
For k = 0 To UBound(kol)
tb(j, k + 1) = tb(i, kol(k))
Next
End If
End If
End If
Next i
If j > 0 Then OutSht.Cells(OutSht.Rows.Count, "A").End(xlUp).Offset(1).Resize(j, UBound(kol) + 1) = tb
End With
End Sub

[mokie]

Thanks. Great. Everything looking perfect.
I'm so happy that I found this place. And so helpfull member.
P45Cal - You're awesome. You're made my week better:]

Now I need to do some changes for real data but it could be works as good as example.

[mokie]

Hello again. And apologize for get wade again:)

After tested in real DataBase sometimes I don't have alwayes (in column with uniqe number..) number but it could be empty cell.

The item in this row is also importent to me.
It's working good that is copy that row without unique number becouse I need it:)

The problem is that when I copy again it was paste many times the same "empty" not match record (not check that is exist)
To solve that problem I thing in logic is it possible because in those "empty" row has unique after join column 3,4,5 in that row.
To easier to manage it was for me if that records not like normal records starts to row 7 to 499 (I thing with my requirement thats could enough)
And that nonunique starts to paste on 500 row.


The other issue.
I'll try to join union.range (uncountinues) to not only search match on column 2(B) but on column 2,16,32
Why It doesn't work with range uniun. It's possible to modyficate the code on that way?


Dim c2Range As Range, c16Range As Range, c32Range As Range
Dim bigRange as Range
(..)
Set OutSht = ThisWorkbook.ActiveSheet
Set c2Range = OutSht.Columns(2)
Set c16Range = OutSht.Columns(16)
Set c16Range = OutSht.Columns(32)
Set bigRange = Union(c2Range, c16Range, c32Range)
(..)

If IsError(Application.Match(tb(i, 2), bigRange, 0)) Then (..)

Thanks in advance.

[p45cal]

in those "empty" row has unique after join column 3,4,5 in that row.
Uniques built from columns 3,4 & 5 in the DataBase sheet?
or from columns 3,4 & 5 in the OutSheet sheet?

[p45cal]

And whatever the answer to that, if a blank cell is encountered in column 2 of the DataBase sheet, do you want to check all other sheets for the same thing before copying to OutSheet?

[mokie]

Hello. P45Cal

It's a little bit complicated but I don't have permmision to change the database. I tested data and I found a reccurence for 100% per.

Normal records with unique number sometimes maight have duplicate on 3,4,5 that means I need to found that only by Uniqe column.
Unnormal records without unique number on 99% has after split 3&4&5 like a unique. on both sheet (file).

In logic: About Your Question:
But for that case:
If no unique number but record fullfills the requirements
and exist in Array because doesn't much with unique (on OutSheets)
For this recors in array
I need to check again QutSheet(3,4,5) vs Array(3,4,5) before paste "empty" exist unique number
And I need to check all worksheet.


We need to back on those version of array

kol = Array(1, 2, 3, 4, 5, 6, 7, 12)


** ps about: The other issue. I was starting new Thread with Range Unions vs Arrays with some variation with your solution on this topic:)
58594-Union-range-vs-Arrays-(error-out-of-range)

Thanks in advanced:)

[p45cal]

I'm working on this.
We need to back on those version of array
kol = Array(1, 2, 3, 4, 5, 6, 7, 12)
Originally you wanted:
kol = Array(1, 2, 3, 7, 12)
but it is clear you must include all columns in the Outsheet that you want to use to build a unique combination/concatenation from.
Question 1. Are those three columns originally from columns C, D and E on the DataBase sheet? If not, which columns from the DataBase sheet do you want to use to form the unique combination?

Be aware that you can have something like:
kol = Array(1, 2, 3, 7, 12, 4, 5)
so that those extra columns are out of the way (to the right).

Question 2. Bearing that in mind, what would you like kol to be? (You can always change it later.)


** ps about: The other issue. I was starting new Thread with Range Unions vs Arrays with some variation with your solution on this topic:)
58594-Union-range-vs-Arrays-(error-out-of-range)I have a solution for this which is not too slow.

[mokie]

I'm working on this.
Originally you wanted:
kol = Array(1, 2, 3, 7, 12)
but it is clear you must include all columns in the Outsheet that you want to use to build a unique combination/concatenation from.
Question 1. Are those three columns originally from columns C, D and E on the DataBase sheet? If not, which columns from the DataBase sheet do you want to use to form the unique combination?

Be aware that you can have something like:
kol = Array(1, 2, 3, 7, 12, 4, 5)
so that those extra columns are out of the way (to the right).
Yes. I mix a little bit because first time I do my example without oryginal database. Sory my bad I thinking it won't be matter.

Oryginal places where You find the Unique.
1.Column B (unique number)
2. Column C & D & G (additional unique number) STRING
example: 123456 & 5 & 1,5 = need to be 12345651,5
example: 123322 & 19 & "" = need to be 1232219

If is in a case. On OutSheet could be on the same places. B,C,D,G
Some column no importent I could hide.



Question 2. Bearing that in mind, what would you like kol to be? (You can always change it later.)

I have a solution for this which is not too slow.
P45Cal I'm not sure what You mean?:)
if You ask about Array or range
Like Array like now is easy to managed because ; system source data can changes in future.

[p45cal]

2. Column C & D & GThis is what I wanted to know.





P45Cal I'm not sure what You mean?
re:
Question 2. Bearing that in mind, what would you like kol to be? (You can always change it later.)
eg. would you want:
kol = array(1,2,3,7,12,4)
kol = array(1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) 'silly I know.
kol = ?


re: "Range Unions vs Arrays"
Just telling you that this bit has been solved. You will see how later.

[mokie]

P45Cal it Sounds good :):):)

I understand. I probably want to mix data like that in first your example.
I don't need to copy all and I prefer mix on output seems like
kol = array(1,2,3,4,7,5,12,9,11)

[p45cal]

Could you test this please:
Sub SearchReq6()
Dim tb, OutSht, IsNowhereElse As Boolean, sht
Dim i As Long, j As Long, k As Long, kol
Dim req1, req2, req3DateLowL, req4DateUppL

kol = Array(1, 2, 3, 4, 7, 5, 12, 9, 11) 'newer 'maps out the arrangement of columns from the DataBase sheet to the OutSheet.
DBaseUniqNumberColm = 2 'the column holding the unique numbers on the DataBase sheet (and others except for OutSheet)
'prepare some arrays of combinations of columns of other sheets to be used for searching for duplicates later:
OtherSheetsColms = Array(3, 4, 7) 'the other sheets (includes DataBase sheet) columns to concatenate to make unique combo to check against when unique number is blank.

'Only the above 3 variables (kol, DBaseUniqNumberColm and OtherSheetsColms) need to be set manually; the rest are worked out (I think!)
'Note we could also put the 65000 in a variable; it might save a little time to change it to x if you know you will NEVER have more than x rows on any sheet, ever. The actual maximum is 65536

'OutSheetColms = Array(3, 4, 5) 'the OutSheet columns to concatenate to make unique combo when unique number is blank.
OutSheetColms = Array(Application.Match(OtherSheetsColms(0), kol, 0), Application.Match(OtherSheetsColms(1), kol, 0), Application.Match(OtherSheetsColms(2), kol, 0)) 'automation of commented-out line above.
OutShtUniqNumberColm = Application.Match(DBaseUniqNumberColm, kol, 0) 'works out which column in the OutSheet has the Unique Numbers.
ReDim ff(1 To Sheets.Count)
j = 0
For Each sht In ThisWorkbook.Sheets 'exclude outsht and database
If sht.Name <> "DataBase" Then '"OutSheet" Then 'And sht.Name <> "DataBase" Then
j = j + 1
If sht.Name = "OutSht" Then 'because there was a different set of columns to be used in the OutSheet.
a = sht.Cells(5, OutSheetColms(0)).Resize(65000).Value
b = sht.Cells(5, OutSheetColms(1)).Resize(65000).Value
c = sht.Cells(5, OutSheetColms(2)).Resize(65000).Value
Else
a = sht.Cells(2, OtherSheetsColms(0)).Resize(65000).Value 'do the other sheets' data start at row 5 too? If so change the 2 to a 5 (same applies to next 2 lines).
b = sht.Cells(2, OtherSheetsColms(1)).Resize(65000).Value
c = sht.Cells(2, OtherSheetsColms(2)).Resize(65000).Value
End If
ReDim d(1 To UBound(a))
For k = 1 To UBound(d)
If Not (IsEmpty(a(k, 1)) And IsEmpty(b(k, 1)) And IsEmpty(c(k, 1))) Then
'If IsEmpty(c(k, 1)) Then cc = Empty Else cc = CStr(CLng(c(k, 1))) 'may no longer need the clng. 'Remnant from when 3rd column was a date.
d(k) = a(k, 1) & "¬" & b(k, 1) & "¬" & c(k, 1)
End If
Next k
ff(j) = d
End If
Next sht
ReDim Preserve ff(1 To j)
'end of creating lookup (Match) arrays.

Set OutSht = ThisWorkbook.Sheets("OutSheet")
With ThisWorkbook.Sheets("DataBase")
req1 = .[A2]
req2 = .[B2]
req3DateLowL = .[E2]
req4DateUppL = .[F2]
tb = .Range("A5:L" & .Cells(.Rows.Count, 2).End(xlUp).Row) 'this uses column 2 to decide where the bottom of the table is; this may not be the best since you've told me that some unique numbers can be blamk - so change this.
j = 0
For i = 1 To UBound(tb)
If (tb(i, 4) = req1) And (tb(i, 11) >= req3DateLowL) And (tb(i, 11) <= req4DateUppL) Or ((tb(i, 4) = req2 And (tb(i, 11) >= req3DateLowL And tb(i, 11)) <= req4DateUppL)) Then
'check for presence elsewhere: search the other sheets:
IsNowhereElse = True
If IsEmpty(tb(i, DBaseUniqNumberColm)) Then 'if unique number is blank,search for the columns C,D,E combo in other sheets:
'Stop
'pp = tb(i, 3) & tb(i, 4) & IIf(IsEmpty(tb(i, 5)), Empty, CLng(tb(i, 5))) 'column 5 treated diferently since it contains dates.
' pp = tb(i, 3) & "¬" & tb(i, 4) & "¬" & tb(i, 7)
pp = tb(i, OtherSheetsColms(0)) & "¬" & tb(i, OtherSheetsColms(1)) & "¬" & tb(i, OtherSheetsColms(2)) 'automation of above, commented-out, line.
For k = LBound(ff) To UBound(ff)
If Not IsError(Application.Match(pp, ff(k), 0)) Then 'this is the line that has the limit of 65k plus members in ff(k).
IsNowhereElse = False
Exit For
End If
Next k
Else 'if unique number is not blank: this bit searches for unique number match elsewhere:
For Each sht In ThisWorkbook.Sheets
If sht.Name <> "DataBase" Then
If sht.Name = "OutSht" Then myColm = OutShtUniqNumberColm Else myColm = DBaseUniqNumberColm
If Not IsError(Application.Match(tb(i, DBaseUniqNumberColm), sht.Columns(myColm), 0)) Then
IsNowhereElse = False
Exit For
End If
End If
Next sht
End If
'end search the other sheets.
If IsNowhereElse Then
'check all values aren't empty first (no sense copying a blank row):
AllEmpty = True
For k = LBound(kol) To UBound(kol)
If Not IsEmpty(tb(i, kol(k))) Then
AllEmpty = False
Exit For
End If
Next
'end of check all values aren't empty first
If Not AllEmpty Then
j = j + 1
For k = LBound(kol) To UBound(kol)
tb(j, k + 1) = tb(i, kol(k))
Next
End If
End If
End If
Next i
If j > 0 Then OutSht.Cells(OutSht.Rows.Count, "A").End(xlUp).Offset(1).Resize(j, UBound(kol) + 1) = tb
End With
End Sub

Regarding having the rows with no unique numbers at the bottom, sort on that column.

What this will NOT do is eliminate duplicates if they are present on the DataBase sheet.
Either Remove Duplicates on that sheet before running, or Remove Duplicates on the OutSheet after running (which is what I would have suggested as a quick-and-dirty solution).

[p45cal]

A correction is needed to cater for the time when writing to tb and from tb on the same index:
Sub SearchReq6()
Dim tb, OutSht, IsNowhereElse As Boolean, sht
Dim i As Long, j As Long, k As Long, kol
Dim req1, req2, req3DateLowL, req4DateUppL

kol = Array(1, 2, 3, 4, 7, 5, 12, 9, 11) 'newer 'maps out the arrangement of columns from the DataBase sheet to the OutSheet.
DBaseUniqNumberColm = 2 'the column holding the unique numbers on the DataBase sheet (and others except for OutSheet)
'prepare some arrays of combinations of columns of other sheets to be used for searching for duplicates later:
OtherSheetsColms = Array(3, 4, 7) 'the other sheets (includes DataBase sheet) columns to concatenate to make unique combo to check against when unique number is blank.

'Only the above 3 variables (kol, DBaseUniqNumberColm and OtherSheetsColms) need to be set manually; the rest are worked out (I think!)
'Note we could also put the 65000 in a variable; it might save a little time to change it to x if you know you will NEVER have more than x rows on any sheet, ever. The actual maximum is 65536

'OutSheetColms = Array(3, 4, 5) 'the OutSheet columns to concatenate to make unique combo when unique number is blank.
OutSheetColms = Array(Application.Match(OtherSheetsColms(0), kol, 0), Application.Match(OtherSheetsColms(1), kol, 0), Application.Match(OtherSheetsColms(2), kol, 0)) 'automation of commented-out line above.
OutShtUniqNumberColm = Application.Match(DBaseUniqNumberColm, kol, 0) 'works out which column in the OutSheet has the Unique Numbers.
ReDim ff(1 To Sheets.Count)
j = 0
For Each sht In ThisWorkbook.Sheets 'exclude outsht and database
If sht.Name <> "DataBase" Then '"OutSheet" Then 'And sht.Name <> "DataBase" Then
j = j + 1
If sht.Name = "OutSht" Then 'because there was a different set of columns to be used in the OutSheet.
a = sht.Cells(5, OutSheetColms(0)).Resize(65000).Value
b = sht.Cells(5, OutSheetColms(1)).Resize(65000).Value
c = sht.Cells(5, OutSheetColms(2)).Resize(65000).Value
Else
a = sht.Cells(2, OtherSheetsColms(0)).Resize(65000).Value 'do the other sheets' data start at row 5 too? If so change the 2 to a 5 (same applies to next 2 lines).
b = sht.Cells(2, OtherSheetsColms(1)).Resize(65000).Value
c = sht.Cells(2, OtherSheetsColms(2)).Resize(65000).Value
End If
ReDim d(1 To UBound(a))
For k = 1 To UBound(d)
If Not (IsEmpty(a(k, 1)) And IsEmpty(b(k, 1)) And IsEmpty(c(k, 1))) Then
'If IsEmpty(c(k, 1)) Then cc = Empty Else cc = CStr(CLng(c(k, 1))) 'may no longer need the clng. 'Remnant from when 3rd column was a date.
d(k) = a(k, 1) & "¬" & b(k, 1) & "¬" & c(k, 1)
End If
Next k
ff(j) = d
End If
Next sht
ReDim Preserve ff(1 To j)
'end of creating lookup (Match) arrays.
Set OutSht = ThisWorkbook.Sheets("OutSheet")
With ThisWorkbook.Sheets("DataBase")
req1 = .[A2]
req2 = .[B2]
req3DateLowL = .[E2]
req4DateUppL = .[F2]
tb = .Range("A5:L" & .Cells(.Rows.Count, 2).End(xlUp).Row) 'this uses column 2 to decide where the bottom of the table is; this may not be the best since you've told me that some unique numbers can be blamk - so change this.
ReDim tempArray(1 To UBound(tb, 2))
j = 0
For i = 1 To UBound(tb)
If (tb(i, 4) = req1) And (tb(i, 11) >= req3DateLowL) And (tb(i, 11) <= req4DateUppL) Or ((tb(i, 4) = req2 And (tb(i, 11) >= req3DateLowL And tb(i, 11)) <= req4DateUppL)) Then
'check for presence elsewhere: search the other sheets:
IsNowhereElse = True
If IsEmpty(tb(i, DBaseUniqNumberColm)) Then 'if unique number is blank,search for the columns C,D,E combo in other sheets:
'Stop
'pp = tb(i, 3) & tb(i, 4) & IIf(IsEmpty(tb(i, 5)), Empty, CLng(tb(i, 5))) 'column 5 treated diferently since it contains dates.
' pp = tb(i, 3) & "¬" & tb(i, 4) & "¬" & tb(i, 7)
pp = tb(i, OtherSheetsColms(0)) & "¬" & tb(i, OtherSheetsColms(1)) & "¬" & tb(i, OtherSheetsColms(2)) 'automation of above, commented-out, line.
For k = LBound(ff) To UBound(ff)
If Not IsError(Application.Match(pp, ff(k), 0)) Then 'this is the line that has the limit of 65k plus members in ff(k).
IsNowhereElse = False
Exit For
End If
Next k
Else 'if unique number is not blank: this bit searches for unique number match elsewhere:
For Each sht In ThisWorkbook.Sheets
If sht.Name <> "DataBase" Then
If sht.Name = "OutSht" Then myColm = OutShtUniqNumberColm Else myColm = DBaseUniqNumberColm
If Not IsError(Application.Match(tb(i, DBaseUniqNumberColm), sht.Columns(myColm), 0)) Then
IsNowhereElse = False
Exit For
End If
End If
Next sht
End If
'end search the other sheets.
If IsNowhereElse Then
'check all values aren't empty first (no sense copying a blank row):
AllEmpty = True
For k = LBound(kol) To UBound(kol)
If Not IsEmpty(tb(i, kol(k))) Then
AllEmpty = False
Exit For
End If
Next
'end of check all values aren't empty first
If Not AllEmpty Then
j = j + 1
If j = i Then
For k = LBound(tempArray) To UBound(tempArray) 'copy table row:
tempArray(k) = tb(i, k)
Next
For k = LBound(kol) To UBound(kol) 'now get data from copy:
tb(j, k + 1) = tempArray(kol(k))
Next
Else
For k = LBound(kol) To UBound(kol)
tb(j, k + 1) = tb(i, kol(k))
Next
End If
End If
End If
End If
Next i
If j > 0 Then OutSht.Cells(OutSht.Rows.Count, "A").End(xlUp).Offset(1).Resize(j, UBound(kol) + 1) = tb
End With
End Sub
(The changes are after If Not AllEmpty Then… )

[mokie]

Thank You P45Cal is huge and oustanding peformance with coding.
I don't know if I'm doing something wrong with Your code.

It's work in that way.
When The Array is in sequence (not a mix is correct)

kol = Array(1, 2, 3, 4, 5, 6, 7, 12, 9, 11)
OtherSheetsColms = Array(3, 4, 7)
That You don't need to read text below:) about my expirience:)


First time it doesn't work at night. And when I saw how many transfprmation Your are put in the code I got lost. I afraid that I gave You wrong instruction.

In the morning. I still don't get all operation in code ;d (some of logical why You transform Yes but probably I need some days to "digest" new thing.
Next I looking for it.
I read Yout descriptions and stop at local window what's going on.

DataBase have columns form 1 to 20.
DataBase (1-20) <> OUTSheet (ex. 1-8) = OtherSheet (1-8) ''' about placs the same column
We took from DataBase those column kol = Array(1, 2, 3, 4, 7, 5, 12, 9, 11)
unique = 2 ; additional unique 3,4,7
Copy from DataBase column we paste it to OutSheet. The same sequence of column from OutSheet I got OtherSheet.

We got it some data before coping new on OutSheet this record form DATABASE B,C,D,G is on B,C,D,E in Outsheet=OtherSheet

The same column in OutSheet and OtherSheet ;
unique = 2 ; additional unique 3,4,5

I thing first that I need change the code from But those empty unique is still paste again to OutSheet.

kol = Array(1, 2, 3, 4, 7, 5, 12, 9, 11)
OtherSheetsColms = Array(3, 4, 7)
to:

OtherSheetsColms = Array(3, 4, 5)

But It's working in two opction. When The Array is in sequence

kol = Array(1, 2, 3, 4, 5, 7, 12, 9, 11)
OtherSheetsColms = Array(3, 4, 5)
Or
If I copy manually form empty column (2) unique in OutSheet or OtherSheet
value from column 5 to column 7,



Sorry for complains because in local window what I saw it's need to work properly.

[p45cal]

I cannot make out what you're trying to say.
Send me a copy of the actual file you're working on, with multiple sheets etc. privately.
Send me a Private Message here asking for my private email address to send it to.

[p45cal]

I'm guessing that the DataBase sheet is the ONLY sheet with a different arrangement of columns
and
that all the other sheets (including OutSheet) have the same arrangement of columns (different from the DataBase sheet)?

It may be possible, instead of using column numbers/letters, to use the column header text like (tree, four, five, six as you have in your sample file) to determine which columns to use on all the sheets, regardless of whether they're the OutSheet, DataBase sheet or any other. All the sheets could have a different arrangement of headers, it wouldn't matter. Ideally the header text will be the same in all sheets for the same information, but even if that is not the case, we could correlate different headers to each other.

I really need a real file to work with rather than the sample file I have.

[mokie]

P45Cal. Thank You for all Your concern. Ok I will send to you files.

For example I was trying to help step by step for particular think.
I don't want to waste Your time. But all project it could be more difficult as now.


In real:
DataBase is in diffrent file.

Headers:
I thought that Header Name it'not important.

About OutSheets need to be usefull:)
I'd like to solve manage assembly tools - and try to remove some paper works for me and other guys.
On those file it will be work - 3 crews from different production dep. And I need to be sure that I don't have duplicate in there because right now is big Issue for me.
How the Output file and All OutputSheet looksLike is determinate by Day by day expirance.
It means that I will decide now - how it will be look like :)

New think: About duplicates:
I found that I have more duplicates as I now elier ;/ but If some duplicates have 0,0 points in DataBase. I'd like to have that record only one i Outsheets.


I send on forum file with examle for everyone Who looking for simiilar things. I changed for oryginal code that data is transfering from DataBase to ActiveSheet.
and I will send to You some oryginal data. And possibility how I try to manage with my records by day/ by weeks.

18381