VB to match values in two columns and throw the exact values in the 05th column

[monda24]

Hello,

I am looking for a Macro which can always match values with column A and reflect the similar values between column A and Column B on Column E.

So, the values in column A are always constant, these values are the standard/defualt values that we are using always to match. Column B are the new values that we paste from a new sheet. Am looking for a macro that can :

1. Remove duplicates from column B
2.Match the values in column B with column A and highlight the similar values in column B
3.Throw the similar values within A and B to column E(so, throw the highlighted values in column E)

Please let me know in case I need to upload a file.

Many thanks in advance

 

[saltkev]

Oh My GOD!! It worked Kev! I was actually looking for the entire cell highlight but there was no option to select highlight on this site when I created the table yesterday. Sorry if that created any confusion.. I Copied the code from the first one for highlight cell and replaced in the last one..
One last question..it is deleting the heading for column E and giving me results from e1, I was looking for results from e2..

Thank you very very much!! Have a nice time!

OK No Problems

Write down exactly what you want, highlights in which colmn, starting in which cell in column "E" etc and I will have a look. It will be a while now I am on holiday until Tuesday.

regards

Kev

 

[monda24]

Thank you ..I was looking to highlight all the values in column B that match with column A.. And the result should start in E2. Sure, at your convenience..

 

[monda24]

One flaw that the code is giving me : Every time Am clicking on the macro button it is giving me the exact values again.
For example : In the column A and column B the exact values were

abc123 and efg456 and in column E these two values are reflecting because they are common in both A and B. Then, when ever am clicking on the macro button it is giving me those values again and again.

Like every time I click on the macro assigned button, itis giving me the exact values again and again instead of giving it only once.

[TABLE="class: grid, width: 100, align: center"]
<tbody>[TR]
[TD]Company ids (Column A)[/TD]
[TD] Company ids (Column B)[/TD]
[TD]Column C[/TD]
[TD]Column D[/TD]
[TD]Column E RESULTS [/TD]
[/TR]
[TR]
[TD]abc123[/TD]
[TD]abc123[/TD]
[TD][/TD]
[TD][/TD]
[TD]abc123[/TD]
[/TR]
[TR]
[TD]def456[/TD]
[TD]007lkj[/TD]
[TD][/TD]
[TD][/TD]
[TD]ghi789[/TD]
[/TR]
[TR]
[TD]ghi789[/TD]
[TD]iklpo[/TD]
[TD][/TD]
[TD][/TD]
[TD]abc123[/TD]
[/TR]
[TR]
[TD]jkl001[/TD]
[TD]ghi789[/TD]
[TD][/TD]
[TD][/TD]
[TD]ghi789[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]abc123[/TD]
[/TR]
[TR]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD][/TD]
[TD]ghi789[/TD]
[/TR]
</tbody>[/TABLE]

 

[saltkev]

OK

I realised that was a problem and fixed it, so which of the sections of code that I posted are you using, the third post is the latest, however, it is not the final as we agreed Iwould look again on Tuesday.

 

[monda24]

OK

I realised that was a problem and fixed it, so which of the sections of code that I posted are you using, the third post is the latest, however, it is not the final as we agreed Iwould look again on Tuesday.

am using the last one....

 

[saltkev]

Use the one that you think is the first one, that will be the last one I posted, however it still needs alteration to begin dumping the data in "E2" rather than "E1"

Regards

Kev

 

[monda24]

Hi Kev,

Am using the one that had "Error found after testing " heading in it. Apart from the E1 E2 issue the macro is also giving me the values again and again everytime i click on the macro assigned button..

Many thanks
Priya

 

[saltkev]

Hi Priya

Try this I have tested and it works well.

Application.ScreenUpdating = False
Sheets("sheet1").Activate
Dim fcomp, rng, RangeA, RangeB, RangeE, lrA, lrB, lrC
'######### Define Working Ranges #########
lrA = Sheets("sheet1").Range("a1000000").End(xlUp).Row
      
RangeA = Sheets("sheet1").Range("a2:a" & lrA).Address(False, False)
lrB = Sheets("sheet1").Range("b1000000").End(xlUp).Row
      
RangeB = Sheets("sheet1").Range("B2:B" & lrB).Address(False, False)
lrE = Sheets("sheet1").Range("e1000000").End(xlUp).Row
      
RangeE = Sheets("sheet1").Range("e2:e" & lrE).Address(False, False)
'######### Clear Column "E" #########
    Range(RangeE).Select
    Selection.ClearContents
    Range("A1").Select
    
 '######### Return Column "B" To Original Text Colour #########
 
    ActiveSheet.Range(RangeB).Select
             
                   With Selection.Font
                          .ColorIndex = xlAutomatic
                          .TintAndShade = 0
                   End With
    
'######### Removes Duplicates From Column "B" #########
    Application.CutCopyMode = False
    ActiveSheet.Range(RangeB).RemoveDuplicates Columns:=1, Header:=xlNo
'######### Find & Mark Matches #########
For Each fcomp In Sheets("sheet1").Range(RangeA) ' Range of Source Comparison,
FindString = fcomp
   
   If fcomp.Value > "" Then
        
        With Sheets("sheet1").Range(RangeB) 'Range of cells to search
            Set rng = .Find(What:=FindString, _
                            After:=.Cells(1), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlPrevious, _
                            MatchCase:=False)
            
           If rng Is Nothing Then
                            
           Else
            
                rng.Select
                
 '######### If Red Font Required Rather Than Red Highlight Interchange This Section of Code With The Green Commented Code in This Section #########
                
                        With Selection.Interior
                          .Pattern = xlSolid
                          .PatternColorIndex = xlAutomatic
                          .Color = 255
                          .TintAndShade = 0
                          .PatternTintAndShade = 0
                        End With
                                  
                       ' With Selection.Font
                        '        .Color = -16776961
                         '       .TintAndShade = 0
                        'End With
               
 '######### Copy & Past Values #########
              
                If ActiveSheet.Range("e2").Value = "" Then
 
                    ActiveSheet.Range("e2").Value = fcomp
 
                    GoTo ender
 
                End If
 
                If ActiveSheet.Range("e2").Value > "" And ActiveSheet.Range("e3").Value = "" Then
 
                    ActiveSheet.Range("e3").Value = fcomp
                     
                    GoTo ender
 
                End If
 
                If ActiveSheet.Range("e2").Value > "" And ActiveSheet.Range("e3").Value > "" Then
 
                    Range("e2").Select
                    Selection.End(xlDown).Select
                    ActiveCell.Offset(1, 0).Select
                    ActiveCell.Value = fcomp
                     
                    GoTo ender
 
                End If
 
           End If
            
        End With
        
    End If
        
     
ender:
        
Next fcomp

Regards

Kev

 

[monda24]

Hey Kev, the above macro is deleting the heading from e1..it is working well, except for it is deleting the heading of the column from e1...Many thanks!

 

[saltkev]

Hi

replace the code Define working ranges with this, or add "+ 1" to the 5th line

regards

Kev

'######### Define Working Ranges #########
lrA = Sheets("sheet1").Range("a1000000").End(xlUp).Row
      
RangeA = Sheets("sheet1").Range("a2:a" & lrA).Address(False, False)
lrB = Sheets("sheet1").Range("b1000000").End(xlUp).Row
      
RangeB = Sheets("sheet1").Range("B2:B" & lrB).Address(False, False)
lrE = Sheets("sheet1").Range("e1000000").End(xlUp).Row + 1
      
RangeE = Sheets("sheet1").Range("e2:e" & lrE).Address(False, False)