How to write matched values in one cell wihout being overwritten?

excelnewb

New member
Joined
Jan 10, 2013
Messages
1
Reaction score
0
Points
0
Hi,
Routine below
Code:
Range("M2").Value = i.Value
overwrites the values on top of each other and only the last value from "A1:F17" is shown in "M2". How do I modify it so it writes all the values in "M2" separated by a dash or space? or maybe show it in column M.
Thank you again.

Code:
Sub Compare2A()     
Dim LstRw As Long, c As Range, i As Range     
Application.ScreenUpdating = False     
LstRw=Cells.Find(What:="*",SearchOrder:=xlRows,                                 SearchDirection:=xlPrevious,                                                     
         LookIn:=xlValues).Row     
          For Each c In Range("A1:F17")         
          For Each i In Range("K1:K" & LstRw)             
      If c.Value = i.Value Then                 
            c.Interior.ColorIndex = 6
                Range("M2").Value = i.Value             
End If         
Next i     
Next c     
Application.ScreenUpdating = True 
End Sub


Thank you for your help.
 
Two options:
Code:
Sub Compare2A()
    Dim LstRw As Long, c As Range, i As Range
    Dim sValue As String
    Application.ScreenUpdating = False
    LstRw = Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    
    For Each c In Range("A1:F17")
        For Each i In Range("K1:K" & LstRw)
            If c.Value = i.Value Then
                c.Interior.ColorIndex = 6
                sValue = sValue & i.Value & "-"
            End If
        Next i
    Next c
    sValue = Left(sValue, Len(sValue) - 1)
    Range("M2").Value = sValue
    Application.ScreenUpdating = True
End Sub
Sub Compare2B()
    Dim LstRw As Long, c As Range, i As Range
    Dim lrow As Row
    Application.ScreenUpdating = False
    lrow = 2
    LstRw = Cells.Find(What:="*", SearchOrder:=xlRows, _
    SearchDirection:=xlPrevious, LookIn:=xlValues).Row
    
    
    For Each c In Range("A1:F17")
        For Each i In Range("K1:K" & LstRw)
            If c.Value = i.Value Then
                c.Interior.ColorIndex = 6
                Range("M" & lrow).Value = i.Value
                lrow = lrow + 1
            End If
        Next i
    Next c
    Application.ScreenUpdating = True
End Sub

The first will put it all in M2 separated by dashes. The second will put the data in M2, M3, M4, etc...
 
Back
Top