VBA - Compare Two Sheets and Pull Results on New Sheet

[Starbel]

Hi all,



My skill in translating logic into a formula and especially VBA is very limited. Hopefully the below makes sense.



Basically I was hoping for a VBA code that pulls through results on to a new sheet by using the reference column A (Order Ref) in Sheet 2 and comparing columns of the corresponding Column A in Sheet 1. I was then hoping to pull through results on to sheet 3 based on the following unrelated columns in Sheet 2 –

1. Column I = Y

and is

1. Column G = more than 6 months difference in date vs sheet 1 (sheet 1 will have the later/future dates)

OR

1. Column B = does not match column B in sheet 1

Hopefully the below helps illustrate this –

Sheet 1​
A​	B​	C​	D​	E​	F​	G​	H​	I​	J​
Order Ref​	Customer​	Type​	PO​	BA​	VALUE​	Order Start​	Discount​	Duty​	Duty Startdate​
123​	Harry​	Apple​	1​	New Request​	$3,443.00​	01/06/2022​	Y​	N​	01/07/2022​
14300​	John​	Pear​	3​	New Request​	$655.00​	01/04/2022​	Y​	N​	01/04/2022​
7800​	Kevin​	Orange​	5​	New Request​	$656.00​	01/06/2022​	Y​	N​	01/04/2023​
7800​	Peter​	Mango​	7​	New Request​	$453.00​	01/04/2023​	Y​	Y​	01/04/2023​
73900​	James​	Strawberry​	1​	New Request​	$656.00​	01/02/2023​	Y​	Y​	01/07/2023​
900​	Jack​	Blackberry​	2​	New Request​	$567.00​	01/03/2023​	​	N​	01/03/2023​
18800​	Levi​	Pineapple​	4​	New Request​	$3,445.00​	03/06/2023​	Y​	N​	03/06/2023​
188002​	Leon​	Apple​	6​	New Request​	$676.00​	01/01/2014​	Y​	Y​	01/01/2014​
Sheet 2​
A​	B​	C​	D​	E​	F​	G​	H​	I​	J​
Order Ref​	Customer​	Type​	PO​	BA​	VALUE​	Order Start​	Discount​	Duty​	Duty Startdate​
123​	Harry​	Apple​	1​	New Request​	$3,443.00​	01/06/2022​	Y​	Y​	01/06/2022​
14300​	John​	Pear​	3​	New Request​	$655.00​	01/04/2022​	Y​	Y​	01/04/2022​
7800​	Kevin​	Orange​	5​	New Request​	$656.00​	01/06/2022​	Y​	Y​	01/06/2022​
7800​	Peter​	Mango​	7​	New Request​	$453.00​	01/04/2023​	Y​	Y​	01/04/2023​
73900​	Philip​	Strawberry​	1​	New Request​	$656.00​	01/02/2023​	Y​	Y​	01/06/2023​
900​	Jack​	BlackBerry​	2​	New Request​	$567.00​	01/03/2023​	​	N​	01/03/2023​
18800​	Oscar​	Pineapple​	4​	New Request​	$3,445.00​	03/06/2023​	Y​	Y​	01/04/2021​
188002​	Leon​	Apple​	6​	New Request​	$676.00​	01/01/2014​	Y​	Y​	01/01/2014​
Sheet 3 Results​
A​	B​	C​	D​	E​	F​	G​	H​	I​	J​
Order Ref​	Customer​	Type​	PO​	BA​	VALUE​	Order Start​	Discount​	Duty​	Duty Startdate​
7800​	Kevin​	Orange​	5​	New Request​	$656.00​	01/06/2022​	Y​	N​	01/04/2023​
73900​	James​	Strawberry​	1​	New Request​	$656.00​	01/02/2023​	Y​	Y​	01/07/2023​
18800​	Levi​	Pineapple​	4​	New Request​	$3,445.00​	03/06/2023​	Y​	N​	03/06/2023​
188002​	Leon​	Apple​	6​	New Request​	$676.00​	01/01/2014​	Y​	Y​	01/01/2014​

Thank you so much!

 

[Starbel]

@Flashbond sorry for tagging you in - figured you might be the person for this

 

[Legacy 143009]

Hi,

No problem. But why did you include this? Column I is Y, ok. But the neither date difference is 6 months nor the column B name is different?

 

[Starbel]

Hi,

No problem. But why did you include this? Column I is Y, ok. But the neither date difference is 6 months nor the column B name is different?
View attachment 100948

So sorry @Flashbond - im sure I had it differently in my spreadsheet. Please ignore this discrepancy. Good spot from you!

 

[Legacy 143009]

No worries. I was just curious about the inconsistency.
One more question, do two lists always have the same length?

 

[Starbel]

No worries. I was just curious about the inconsistency.
One more question, do two lists always have the same length?

If by length you mean the number of columns - then yes.

However the rows could be 100s in Sheet 1 and/or 1000s in Sheet 2

 

[Legacy 143009]

Hello,

I didn't understand this line also. Column I is N, ok. So there is no need to check date.
But the column B isn't different neither?

Sorry, I don't think I understand the rules correctly this time.

 

[Starbel]

Hello,

I didn't understand this line also. Column I is N, ok. So there is no need to check date.
But the column B isn't different neither?
View attachment 101006

Sorry, I don't think I understand the rules correctly this time.

Hi there,

So column I being 'N' is the reason for the difference and why it would be extracted on to Sheet 3. So we're on the same page here.

Column B would be another independant test.

e.g

1- Column I difference + more than 6 months difference in column G = Pull on to new sheet

2- Column I no difference, but Column B is different (no need to factor in the date in column G for this test) = Pull on to new sheet


Does that make sense? I feel writing the above may have confused this further.

Many thanks as always!

 

[Legacy 143009]

Assuming there are no repeating Types within the same Order on Sheet2:

Dim tempRange As Variant
Sub tets()
  Dim sheet1Range As Variant, sheet2Range As Variant, tempArr As Variant
  Dim sheet2Dic As Object, i As Long
  Set sheet2Dic = CreateObject("Scripting.Dictionary")
 
  sheet2Range = Worksheets("Sheet2").UsedRange
  For i = 2 To UBound(sheet2Range, 1)
    If Not sheet2Dic.Exists(sheet2Range(i, 1) & sheet2Range(i, 3)) Then
      sheet2Dic.Add sheet2Range(i, 1) & sheet2Range(i, 3), sheet2Range(i, 2) & "|" & sheet2Range(i, 7) & "|" & sheet2Range(i, 9)
    End If
  Next
 
  With Application
  sheet1Range = Worksheets("Sheet1").UsedRange
  ReDim tempRange(1 To UBound(sheet1Range, 2), 1 To 1)
  For i = 2 To UBound(sheet1Range, 1)
    If sheet2Dic.Exists(sheet1Range(i, 1) & sheet1Range(i, 3)) Then
      tempArr = Split(sheet2Dic(sheet1Range(i, 1) & sheet1Range(i, 3)), "|")
      If sheet1Range(i, 9) = tempArr(2) Then
        If sheet1Range(i, 9) > DateAdd("m", 6, tempArr(1)) Then
          tempArr = .Index(sheet1Range, i, 0)
          Call writeTotempRange(tempArr)
        End If
      Else
        If sheet1Range(i, 2) <> tempArr(0) Then
          tempArr = .Index(sheet1Range, i, 0)
          Call writeTotempRange(tempArr)
        End If
      End If
    End If
  Next
 
  ReDim Preserve tempRange(1 To UBound(tempRange, 1), 1 To UBound(tempRange, 2) - 1)
  Worksheets("Sheet3").Range("A1").Resize(1, UBound(sheet1Range, 2)).Value = .Index(sheet1Range, 1, 0)
  Worksheets("Sheet3").Range("A2").Resize(UBound(tempRange, 2), UBound(tempRange, 1)).Value = .Transpose(tempRange)
  End With
End Sub
Public Sub writeTotempRange(ParamArray tempArr() As Variant)
  Dim i As Long
  For i = 1 To UBound(tempRange, 1)
    tempRange(i, UBound(tempRange, 2)) = tempArr(0)(i)
  Next
  ReDim Preserve tempRange(1 To UBound(tempRange, 1), 1 To UBound(tempRange, 2) + 1)
End Sub

 

[Legacy 143009]

Please find my explanations in the results tab:

WeTransfer - Send Large Files & Share Photos Online - Up to 2GB Free

WeTransfer is the simplest way to send your files around the world

we.tl