macro that will match two different column from two different sheets

[p9j123]

Hello Excel Masters,

I badly need help here, I am working on a file that has two sheets.

I need a macro that will match EMPID and PROCODE in Sheet 1(April (2)) with Sheet 2 (Compre List), if found the entire row in Sheet 2 should be deleted then the EMPID[C] and PROCODE[D] should be posted in the next blank row of Sheet 1 ( and [D] of Sheet 1).
Few things to note.

1. Above square brackets represent column letters.
2. I need the macro to look for the first blank row between row 13 to row 25 only, not from the bottom of the sheet.
3. The macro will be run from different sheet (April (1), April (2), April (3), etc.)

Please see the link of the workbook for your reference.

https://app.box.com/s/tw1pzo3hhn1dbwmionpf

 

[NicholasP]

I put data in cell D3 and it still works for me...are you running the macro from the April Sheet?

 

[p9j123]

OMG, my bad I am pulling out the old macro... Im really sorry about that....

One last, can we highlight the copied data as red?

 

[NicholasP]

Like this? Updated, before it didn't work properly

Sub tests()


sht = ActiveSheet.Name

Dim x, y, lstrw As Long

Dim toprng
Set toprng = Range("D1:D" & Cells(Rows.Count, 4).End(xlUp).Row)

Set c = toprng.Find("ProCode", , , xlWhole)
'x = c.Row
x = 12
y = x

Do
y = y + 1
Loop Until Cells(y, 4) = ""

lstrw = y
y = y - 1

Dim rng As Range
Set rng = Range(Cells(x, 4), Cells(y, 4))


Sheets("Compre List").Activate

Z = Cells(Rows.Count, 3).End(xlUp).Row

Dim CompreRng As Range
Set CompreRng = Range(Cells(2, 4), Cells(Z, 4))


Sheets(sht).Activate

For Each cell In rng

Set c = CompreRng.Find(cell, , , xlWhole)
    If Not c Is Nothing Then
        If c.Offset(0, -1) = cell.Offset(0, -2) Then
            c.Interior.ColorIndex = 3
            c.Copy Cells(lstrw, 4)
            
            c.Offset(0, -1).Interior.ColorIndex = 3
            c.Offset(0, -1).Copy Cells(lstrw, 2)
            c.EntireRow.Interior.ColorIndex = 3
            lstrw = lstrw + 1

            ''c.EntireRow.Delete shift:=xlUp
        End If
    End If

Next
     
     






End Sub

 

[p9j123]

can we also highlight the pasted data in Sheet April (2)?

 

[NicholasP]

can we also highlight the pasted data in Sheet April (2)?

Please run the code I posted, I updated it after I realized what I did was incorrect. Let me know how that works...

 

[p9j123]

It works like a charm NicholasP. Thank you so much for your assistance.....

Thank you..... thank you.... thank you.......

 

[p9j123]

Hello Nick,

I hope you can still accommodate my follow up question, can you assist me modify the macro in such a way that if there is a match within Sheet Compre List the macro will highlight it as well.

I have attached the latest file that I am working on, those with xx on J column should be highlighted as well.

https://app.box.com/s/6gqr5u036zltsb0zesp9

 

[NicholasP]

Hello Nick,

I hope you can still accommodate my follow up question, can you assist me modify the macro in such a way that if there is a match within Sheet Compre List the macro will highlight it as well.

I have attached the latest file that I am working on, those with xx on J column should be highlighted as well.

https://app.box.com/s/6gqr5u036zltsb0zesp9

try this, I did use the sort function, so if you need things in a particular order on the CompreList sheet you should take that into account...also, it's not really efficient and I realize I could've used less variables....

Sub tests()


sht = ActiveSheet.Name

Dim x, y, lstrw As Long

Dim toprng
Set toprng = Range("D1:D" & Cells(Rows.Count, 4).End(xlUp).Row)

Set c = toprng.Find("ProCode", , , xlWhole)
'x = c.Row
x = 12
y = x

Do
y = y + 1
Loop Until Cells(y, 4) = ""

lstrw = y
y = y - 1

Dim rng As Range
Set rng = Range(Cells(x, 4), Cells(y, 4))


Sheets("Compre List").Activate

Z = Cells(Rows.Count, 3).End(xlUp).Row

Dim CompreRng As Range
Set CompreRng = Range(Cells(2, 4), Cells(Z, 4))


Sheets(sht).Activate

For Each cell In rng

Set c = CompreRng.Find(cell, , , xlWhole)
    If Not c Is Nothing Then
        If c.Offset(0, -1) = cell.Offset(0, -2) Then
            c.Interior.ColorIndex = 3
            c.Copy Cells(lstrw, 4)
            
            c.Offset(0, -1).Interior.ColorIndex = 3
            c.Offset(0, -1).Copy Cells(lstrw, 2)
            c.EntireRow.Interior.ColorIndex = 3
            lstrw = lstrw + 1

            ''c.EntireRow.Delete shift:=xlUp
        End If
    End If

Next



Sheets("Compre List").Activate
     
Dim fnlrw, fnlcol As Long

fnlrw = Cells(Rows.Count, 9).End(xlUp).Row
fnlcol = Cells(1, Columns.Count).End(xlToLeft).Column


''Range("A1:I7").Select
Range(Cells(1, 1), Cells(fnlrw, fnlcol)).Select


    ActiveWorkbook.Worksheets("Compre List").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Compre List").Sort.SortFields.Add Key:=Range( _
        "C2:C" & fnlrw), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    ActiveWorkbook.Worksheets("Compre List").Sort.SortFields.Add Key:=Range( _
        "D2:D" & fnlrw), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
        xlSortNormal
    With ActiveWorkbook.Worksheets("Compre List").Sort
        .SetRange Range(Cells(1, 1), Cells(fnlrw, fnlcol))   '''alternatively, Range("A1:I7")
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
For Each cell In Range(Cells(1, 3), Cells(fnlrw, 3))
    If cell = cell.Offset(1, 0) Then
        If cell.Offset(0, 1) = cell.Offset(1, 1) Then
            cell.Interior.ColorIndex = 5
            cell.Offset(0, 1).Interior.ColorIndex = 5
            cell.Offset(1, 0).Interior.ColorIndex = 5
            cell.Offset(1, 1).Interior.ColorIndex = 5
        End If
    End If
Next


End Sub

 

[p9j123]

Thanks NicholasP, anticipated my next question as well.

 

[p9j123]

Hello Nick,

Follow up question, can you assist me modifying the macro in such a way that it highlights the rows until column K only instead of the entire row?