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

YANECKC

Board Regular
Joined
Jun 13, 2002
Messages
194
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
ABCD
1IDSSheetLocationCNTQTYRESULTS
2F27477711.000Match
3C002406122.000Match
4G007154110,000.000Match
5D003293110.000Match
6G0078621500.000-1500
7H1047691108.000118
8A603537110.000Match
9F27477721.000Match
10H01284727.000NoMatch
11A8117952200.000Match
12A68909928.000Match
13D003293210.000Match
14K00378524,149.0009
15C5523422100.000NoMatch
16G13611431,177.000Match
17B2726083148.00011
18D003293315.000Match
19G13611434,507.000Match
20A01814939.000Match
21K0023663580.000Match
22K003785390,000.0009
23C004712362.000-38
24C0151934100,000.000Match
Sheet1


Sheet2
109COUNT9-28.xls
ABCD
1IDSSheetLocationSETTQTYRESULTS
2A0181493-9.00Match
3A6035371-10.00Match
4A6890992-8.00Match
5A8117952-200.00Match
6B2726083-137.0011
7C0024061-22.00Match
8C0047123-100.00-38
9C0151934-100,000.00Match
10C552344-100.00NoMatch
11D0032931,2,3-35.00Match
12F006858-5.00NoMatch
13F2747771,2-2.00Match
14G002303-7.00NoMatch
15G0071541-10,000.00Match
16G0078621-2,000.00-1500
17G1361143,3-5,684.00Match
18H104769110.00Match
19J001975-178.00NoMatch
20K0023663-580.00Match
21K0037852,3-94,140.009
Sheet2


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

Excel Facts

How can you turn a range sideways?
Copy the range. Select a blank cell. Right-click, Paste Special, then choose Transpose.

acw

MrExcel MVP
Joined
Feb 13, 2004
Messages
4,814
Hi

Try the following

Code:
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

Board Regular
Joined
Jun 13, 2002
Messages
194
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
 

Forum statistics

Threads
1,136,504
Messages
5,676,254
Members
419,616
Latest member
quickflip

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top