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

M

monda24

New Member
Joined
Nov 20, 2013
Messages
33
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
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.
Sort by date Sort by votes
Hi

to clarify, when you say similar do you mean the same as, or as you say similar, if the later what degree of similarity, I.E do they need to start with same letter or have the same number of chars, if numeric how close should they be.

regards

Kev
 
Upvote 0
Hey Kev,

I mean the exact..sorry about the confusion. Exact same value.

Example

Coulmn A Column B Column E should have
1 7 4
2 4 5
3 10 7
4 5
5 5
6
7

So basically, the duplicates in column B should delete.

the same values in column A and Column B should get highlighted in some color column and should show in Column E.


Thank you!!
 
Upvote 0
OK

I will have a look at it, It will be tomorrow now, as I am heading off home.

regards

kev
 
Upvote 0
Column
A
Column B
Column E
abcd123
agg000
abc123
efgh456
greg99
efgh456
hijk789
abc123
rst1415
lmn1011
pooh55
opq1213
opq1213
efgh456
rst1415
jake56
uvw1617
rst1415
xyz1819
dunn09
cba2021
opq1213

<tbody>
</tbody>
Sure, I have pasted above what am looking for..thanks a ton!!
 
Upvote 0
Hi
Try this under a command button

Code: 
Application.ScreenUpdating = False
Sheets("sheet1").Activate
Static fcomp, rng, rangeA, rangeB, lrA, lrB
'######### Define Working Ranges #########

lrA = Sheets("sheet1").Range("a1000000").End(xlUp).Row
rangeA = Sheets("sheet1").Range("a1:a" & lrA).Address(False, False)

lrB = Sheets("sheet1").Range("b1000000").End(xlUp).Row
rangeB = Sheets("sheet1").Range("B1:B" & lrA).Address(False, False)

'######### 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
           
              'Do Nothing
                             
            Else
            
              fcomp.Select
                          
               With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .Color = 65535
                    .TintAndShade = 0
                    .PatternTintAndShade = 0
               End With
                                         
               
             rng.Select
             
               With Selection.Interior
                    .Pattern = xlSolid
                    .PatternColorIndex = xlAutomatic
                    .ThemeColor = xlThemeColorAccent2
                    .TintAndShade = 0.399975585192419
                    .PatternTintAndShade = 0
              End With
              
 '######### Copy & Past Values #########
              
 If ActiveSheet.Range("e1").Value = "" Then
 
 ActiveSheet.Range("e1").Value = fcomp
 
 GoTo ender
 
 End If
 
 If ActiveSheet.Range("e1").Value > "" And ActiveSheet.Range("e2").Value = "" Then
 
 ActiveSheet.Range("e2").Value = fcomp
                     
 GoTo ender
 
 End If
 
 If ActiveSheet.Range("e1").Value > "" And ActiveSheet.Range("e2").Value > "" Then
 
 Range("e1").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
 
Upvote 0
Hi

OK there was another language eror there, I will adjust what I have sent you, Highlighting means something different to me. What you wanted is to change colour of text in column "B"
 
Upvote 0
Hi

Re-done with text colour rather than highlight.

Code: 
Application.ScreenUpdating = False
Sheets("sheet1").Activate
Static fcomp, rng, rangeA, rangeB, rangeC, lrA, lrB, lrC
'######### Define Working Ranges #########

lrA = Sheets("sheet1").RangE("a1000000").End(xlUp).Row
      
rangeA = Sheets("sheet1").RangE("a1:a" & lrA).Address(False, False)
lrB = Sheets("sheet1").RangE("b1000000").End(xlUp).Row
      
rangeB = Sheets("sheet1").RangE("B1:B" & lrA).Address(False, False)
lrC = Sheets("sheet1").RangE("e1000000").End(xlUp).Row
      
rangeC = Sheets("sheet1").RangE("e1:e" & lrC).Address(False, False)
'######### Clear Column "E" #########
    RangE(rangeC).Select
    Selection.ClearContents
    RangE("A1").Select
'######### 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,
fcomp.Offset(0, 1).Select
                    With Selection.Font
                            .ColorIndex = xlAutomatic
                            .TintAndShade = 0
                    End With
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
            
              fcomp.Select
                          
                                                      
               
             rng.Select
             
                                  
               With Selection.Font
                    .Color = -16776961
                    .TintAndShade = 0
              End With
              
              
 '######### Copy & Past Values #########
              
 If ActiveSheet.RangE("e1").Value = "" Then
 
 ActiveSheet.RangE("e1").Value = fcomp
 
 GoTo ender
 
 End If
 
 If ActiveSheet.RangE("e1").Value > "" And ActiveSheet.RangE("e2").Value = "" Then
 
 ActiveSheet.RangE("e2").Value = fcomp
                     
 GoTo ender
 
 End If
 
 If ActiveSheet.RangE("e1").Value > "" And ActiveSheet.RangE("e2").Value > "" Then
 
 RangE("e1").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
 
Upvote 0
Error found after testing

Code: 
Application.ScreenUpdating = False
Sheets("sheet1").Activate
Static fcomp, rng, rangeA, rangeB, rangeC, lrA, lrB, lrC
'######### Define Working Ranges #########

lrA = Sheets("sheet1").RangE("a1000000").End(xlUp).Row
      
rangeA = Sheets("sheet1").RangE("a1:a" & lrA).Address(False, False)
lrB = Sheets("sheet1").RangE("b1000000").End(xlUp).Row
      
rangeB = Sheets("sheet1").RangE("B1:B" & lrB).Address(False, False)
lrC = Sheets("sheet1").RangE("e1000000").End(xlUp).Row
      
rangeC = Sheets("sheet1").RangE("e1:e" & lrC).Address(False, False)
'######### Clear Column "E" #########
    RangE(rangeC).Select
    Selection.ClearContents
    RangE("A1").Select
    
    
    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
             
             
                                 
               With Selection.Font
                    .Color = -16776961
                    .TintAndShade = 0
              End With
              
              
 '######### Copy & Past Values #########
              
 If ActiveSheet.RangE("e1").Value = "" Then
 
 ActiveSheet.RangE("e1").Value = fcomp
 
 GoTo ender
 
 End If
 
 If ActiveSheet.RangE("e1").Value > "" And ActiveSheet.RangE("e2").Value = "" Then
 
 ActiveSheet.RangE("e2").Value = fcomp
                     
 GoTo ender
 
 End If
 
 If ActiveSheet.RangE("e1").Value > "" And ActiveSheet.RangE("e2").Value > "" Then
 
 RangE("e1").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
 
Upvote 0
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!
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

B
  • Solved
Need to add two sets of minutes with custom formatting and round
Replies
1
Views
108
bh24524
B
U
  • Question
Lookup/Vlookup to find exact date
Replies
6
Views
238
UndwaterExcelWeaver
U
J
  • Question
Complex Move data from two spreadsheets with similar data in different columns to a specific column in an existing spreadsheet(Sheet 3)
Replies
0
Views
165
JMC57
J
Kellie220
  • Solved
Formula for calculating different dates/ VBA
Replies
3
Views
240
awoohaw
awoohaw
P
  • Question
Automating copying of columns within same sheet in excel using VBA.
Replies
1
Views
235
MountainFog
M

Forum statistics

Threads
1,216,126
Messages
6,129,008
Members
449,480
Latest member
yesitisasport

Share this page

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
Back
Top