one more criteria for vba

[BrutalDawg]

I have a macro that currently looks through two unique sheets and if criteria is met, pulls the row to sheet3. Below.

Sub what_changed()

Dim ws1 As Worksheet, ws As Worksheet, ws3 As Worksheet, ws4 As Worksheet


Set ws1 = Worksheets("Sheet1")
Set ws2 = Worksheets("Sheet2")
Set ws3 = Worksheets("Sheet3")
Set ws4 = Worksheets("Helper")


ws3.Cells().ClearContents
ws4.Cells().ClearContents


wr = 1 'this will biul a List of "INdexNumbers" on sheet 4
For r = 2 To ws1.Range("A" & Rows.Count).End(xlUp).Row
ws4.Cells(wr, "A") = ws1.Cells(r, "A") & ws1.Cells(r, "D") & ws1.Cells(r, "F") & ws1.Cells(r, "G")
ws4.Cells(wr, "B") = ws1.Cells(r, "F") 'qty
wr = wr + 1
Next r




For r = 2 To ws2.Range("A" & Rows.Count).End(xlUp).Row


ino = ws2.Cells(r, "A") & ws2.Cells(r, "D") & ws2.Cells(r, "F") & ws2.Cells(r, "G")


If WorksheetFunction.CountIf(ws4.Range("A:A"), ino) = 0 Then 'add record as something changed


lr = ws3.Cells(Rows.Count, "A").End(xlUp).Row + 1
ws3.Rows(lr).EntireRow.Value = ws2.Rows(r).EntireRow.Value
ws3.Cells(lr, "H") = qty


End If


Next r


End Sub

Now that I know what changed, I would like to bring over just the quantity of the matching items of the first sheet and place it in column I.

Anyone know an easy way to complete this?

Thanks all for the help.

 

[hiker95]

BrutalDawg,

You may want to change the next line of code, from this:

Dim ws1 As Worksheet, ws As Worksheet, ws3 As Worksheet, ws4 As Worksheet


To this:

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet

 

[BrutalDawg]

BrutalDawg,

You may want to change the next line of code, from this:

Dim ws1 As Worksheet, ws As Worksheet, ws3 As Worksheet, ws4 As Worksheet


To this:

Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet, ws4 As Worksheet

You are correct, missed that. Thanks.

I am wondering, if I could possibly just run this code almost twice, but instead of copying the entire row contents from sheet2 and pasting to sheet 3, if I could copy the quantity from ws1 cell F. I would obviously remove the quantity from the imo on the second run.

Any thoughts? I am just trying to take the original quantity "f" from ws1 to ws3 "I"

 

[hiker95]

You are correct, missed that. Thanks.

BrutalDawg,

You are very welcome.

 

[hiker95]

I am wondering, if I could possibly just run this code almost twice, but instead of copying the entire row contents from sheet2 and pasting to sheet 3, if I could copy the quantity from ws1 cell F. I would obviously remove the quantity from the imo on the second run.

Any thoughts? I am just trying to take the original quantity "f" from ws1 to ws3 "I"

BrutalDawg,

So that I could get it right on the first try, can we see your raw data workbook/worksheets, and, what the results (manually formatted by you should look like)?

You can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com

 

[BrutalDawg]

BrutalDawg,

So that I could get it right on the first try, can we see your raw data workbook/worksheets, and, what the results (manually formatted by you should look like)?

You can post your workbook/worksheets to the following free site (sensitive data changed), mark the workbook for sharing, and, provide us with a link to your workbook:

https://dropbox.com

Thanks for your help hiker,

I have uploaded an example that I hope will help. I did not put the existing code into the excel file for security but have also attached that as well.

Hope this helps.

https://www.dropbox.com/s/r5idhomph3nnk13/Compare Edi Example.xlsx?dl=0 - excel

https://www.dropbox.com/s/r5idhomph3nnk13/Compare Edi Example.xlsx?dl=0 - txt

 

[hiker95]

BrutalDawg,

Thanks for the two new links.

I usually put all the raw data worksheets into one worksheet to get a feel for what should happen.

But, because of the size of the raw data it is difficult to follow, understand, the workflow, and, how to solve your request.

And, there are many variables that are not defined?

Maybe someone else on MrExcel will be able to help you.

 

[hiker95]

BrutalDawg,

Maybe one of the Scripting.Dictionary Guru's will be able to help you.

 

[Fluff]

Does this do what you want?

Sub what_changed()

   Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
   Dim Cl As Range
   Dim ValU As String
   
   Set ws1 = Worksheets("Sheet1")
   Set ws2 = Worksheets("Sheet2")
   Set ws3 = Worksheets("Sheet3")
   
   ws3.UsedRange.Offset(1).ClearContents
   
   With CreateObject("Scripting.dictionary")
      .comparemode = vbTextCompare
      For Each Cl In ws1.Range("A2", ws1.Range("A" & Rows.Count).End(xlUp))
         ValU = Cl.Value & Cl.Offset(, 3).Value & Cl.Offset(, 6).Value
         If Not .exists(ValU) Then .Add ValU, Cl.Offset(, 5).Value
      Next Cl
      For Each Cl In ws2.Range("A2", ws2.Range("A" & Rows.Count).End(xlUp))
         ValU = Cl.Value & Cl.Offset(, 3).Value & Cl.Offset(, 6).Value
         If .exists(ValU) And .Item(ValU) <> Cl.Offset(, 5).Value Then
            Cl.EntireRow.Copy ws3.Range("A" & Rows.Count).End(xlUp).Offset(1)
            ws3.Range("H" & Rows.Count).End(xlUp).Offset(1).Value = .Item(ValU)
            ws3.Range("I" & Rows.Count).End(xlUp).Offset(1).FormulaR1C1 = "=rc6-rc8"
         End If
      Next Cl
   End With
End Sub

 

[hiker95]

Fluff,

Another gem for my archives.

It looks like the macro will produce the results that BrutalDawg was looking for.