PDA

View Full Version : Add additional step to macro



BrutalDawg
03-13-2017, 08:58 AM
Hello Board,

I have a macro currently setup to find the change in an order I receive. Where sheet1 is previous week, sheet2 is current week, sheet3 delivers all new or changed results based on columns A D and G. What I would like to add, or even modify, is the math portion for automatically. Currently, my results are copy the whole row from sheet2 and paste into sheet3. Ideally, I would like for it to subtract sheet2 H from sheet1 matching row H column. If match or error, new.

Below is the code I am currently using. I am also attaching raw file before code is ran, and an example output.

Thanks for any help!


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

1862018621

mana
03-18-2017, 04:19 AM
Option Explicit


Sub what_changed()
Dim dic As Object
Dim ws1 As Worksheet, ws2 As Worksheet, ws3 As Worksheet
Dim V1, V2
Dim i As Long
Dim s As String
Dim n
Dim w

Set dic = CreateObject("scripting.dictionary")

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

V1 = ws1.Range("A1").CurrentRegion.Value
V2 = ws2.Range("A1").CurrentRegion.Value

For i = 2 To UBound(V1)
s = V1(i, 1) & V1(i, 4) & V1(i, 5)
dic(s) = Array(V1(i, 1), V1(i, 2), V1(i, 3), V1(i, 4), V1(i, 5), _
V1(i, 6), V1(i, 7), 0)
Next

For i = 2 To UBound(V2)
s = V2(i, 1) & V2(i, 4) & V2(i, 5)
If dic.exists(s) Then
n = V2(i, 6) - dic(s)(5)
Else
n = "New"
End If
dic(s) = Array(V2(i, 1), V2(i, 2), V2(i, 3), V2(i, 4), V2(i, 5), _
V2(i, 6), V2(i, 7), n)
Next

w = Application.Index(dic.items, 0, 0)

ws3.UsedRange.ClearContents
ws3.Range("A2").Resize(UBound(w, 1), UBound(w, 2)).Value = w

End Sub

BrutalDawg
03-20-2017, 08:39 AM
It appears to not be working correctly. I have tried several different ways, after changing the line you requested. I then ran them individually etc.

It appears to not be factoring in the date when requiring the subtraction or any change. Does that make sense? Attached is a full example of my data.