I need a macro to match sheet1 to sheet2 and fill in the RES

[YANECKC]

I need a macro to match sheet1 to sheet2 and fill in the RESULTS column
in both sheets and fill Sheet Location column in Sheet2.

See below how the sheets should look like after I execute the macro.

Sheet1

109COUNT9-28.xls
	A	B	C	D
1	IDS	SheetLocation	CNTQTY	RESULTS
2	F274777	1	1.000	Match
3	C002406	1	22.000	Match
4	G007154	1	10,000.000	Match
5	D003293	1	10.000	Match
6	G007862	1	500.000	-1500
7	H104769	1	108.000	118
8	A603537	1	10.000	Match
9	F274777	2	1.000	Match
10	H012847	2	7.000	NoMatch
11	A811795	2	200.000	Match
12	A689099	2	8.000	Match
13	D003293	2	10.000	Match
14	K003785	2	4,149.000	9
15	C552342	2	100.000	NoMatch
16	G136114	3	1,177.000	Match
17	B272608	3	148.000	11
18	D003293	3	15.000	Match
19	G136114	3	4,507.000	Match
20	A018149	3	9.000	Match
21	K002366	3	580.000	Match
22	K003785	3	90,000.000	9
23	C004712	3	62.000	-38
24	C015193	4	100,000.000	Match
Sheet1

Sheet2

109COUNT9-28.xls
	A	B	C	D
1	IDS	SheetLocation	SETTQTY	RESULTS
2	A018149	3	-9.00	Match
3	A603537	1	-10.00	Match
4	A689099	2	-8.00	Match
5	A811795	2	-200.00	Match
6	B272608	3	-137.00	11
7	C002406	1	-22.00	Match
8	C004712	3	-100.00	-38
9	C015193	4	-100,000.00	Match
10	C552344		-100.00	NoMatch
11	D003293	1,2,3	-35.00	Match
12	F006858		-5.00	NoMatch
13	F274777	1,2	-2.00	Match
14	G002303		-7.00	NoMatch
15	G007154	1	-10,000.00	Match
16	G007862	1	-2,000.00	-1500
17	G136114	3,3	-5,684.00	Match
18	H104769	1	10.00	Match
19	J001975		-178.00	NoMatch
20	K002366	3	-580.00	Match
21	K003785	2,3	-94,140.00	9
Sheet2

Thank you for your anticipated response.
Yaneckc
Yaneckc@aol.com

 

[acw]

Hi

Try the following

Sub bbb()
  
  Dim SrcSH As Worksheet
  Set SrcSH = Worksheets("Sheet1")
  With Sheets("sheet2")
   ' Range("D2:D50").ClearContents
    For Each ce In .Range("A2:A" & .Cells(Rows.Count, 1).End(xlUp).Row)
      If WorksheetFunction.CountIf(SrcSH.Range("a:a"), ce) = 0 Then
        ce.Offset(0, 3).Value = "No Match"
      End If
      If WorksheetFunction.CountIf(SrcSH.Range("a:a"), ce) > 0 Then
        If Abs(WorksheetFunction.SumIf(SrcSH.Range("a:a"), ce, SrcSH.Range("C:C"))) = Abs(ce.Offset(0, 2)) Then
          ce.Offset(0, 3).Value = "Match"
        Else
          ce.Offset(0, 3).Value = WorksheetFunction.SumIf(SrcSH.Range("a:a"), ce, SrcSH.Range("C:C")) + ce.Offset(0, 2)
        End If
        If WorksheetFunction.CountIf(SrcSH.Range("a:a"), ce) = 1 Then
          ce.Offset(0, 1).Value = WorksheetFunction.VLookup(ce.Value, SrcSH.Range("A:B"), 2, False)
        Else
          Set findit = SrcSH.Range("A:A").Find(what:=ce.Value)
          firstadd = findit.Address
          holder = findit.Offset(0, 1).Value
          Set findit = SrcSH.Range("a:a").Find(what:=ce.Value, after:=SrcSH.Range(findit.Address))

          Do
            holder = holder & "," & findit.Offset(0, 1).Value
            Set findit = SrcSH.Range("a:a").Find(what:=ce.Value, after:=SrcSH.Range(findit.Address))

          Loop Until findit.Address = firstadd
          ce.Offset(0, 1).Value = holder
        End If
      End If
    Next ce
  End With
  
  With SrcSH
    For Each ce In .Range("a2:a" & .Cells(Rows.Count, 1).End(xlUp).Row)
      If WorksheetFunction.CountIf(Sheets("sheet2").Range("A:A"), ce.Value) = 0 Then
        ce.Offset(0, 3).Value = "No Match"
      Else
        ce.Offset(0, 3).Value = WorksheetFunction.VLookup(ce, Sheets("sheet2").Range("A:D"), 4, False)
      End If
    Next ce
  End With
    
End Sub

I get a different result for H104769.


Tony

 

[YANECKC]

Tony

That is perfect !

The macro works great !

I made the mistake on Sheet2 in the Result column for H104769.

See what happens when you try to complete a task manually.

Once again thank you so much and keep those great responses coming.

Yaneckc