+ Reply to Thread
Results 1 to 2 of 2

Alter Matching Sub From matching two Ranges to matching one range and list

Hybrid View

  1. #1
    Forum Contributor
    Join Date
    07-11-2010
    Location
    Minneapolis, USA
    MS-Off Ver
    Excel 2016
    Posts
    308

    Alter Matching Sub From matching two Ranges to matching one range and list

    I have this Match Sub which I use but want to alter
    Sub FindMatches_Original()
    Dim PostBackWS As Worksheet
    Dim FindRng As Range, ReplaceRng As Range, fCell As Range, rCell As Range
    Dim lRow1 As Long, lRow2 As Long
     
            With ThisWorkbook.Sheets("Sofa")
                lRow1 = .Range("A" & .Rows.Count).End(xlUp).Row
                Set FindRng =  .Range("B2:B" & lRow1) 
            End With
    
           With ThisWorkbook.Sheets("Helper")
                lRow2 = .Range("A" & .Rows.Count).End(xlUp).Row
                Set ReplaceRng=  .Range("AA2:AA" & lRow2)
           End With
    
           Set PostBackWS = ThisWorkbook.Sheets("XXX")
         
           For Each fCell In FindRng
              Set rCell = ReplaceRng.Find(fCell.Value, , xlValues, xlWhole, xlByRows, xlNext, MatchCase:=False)
                 If Not rCell Is Nothing Then
            
                  PostBackWS.Range(fCell.Address).Offset(0, 1).Value = rCell.Value
            
                 'Set Interior Color for Matches
                  PostBackWS.Range(fCell.Address).Offset(0, 1).Interior.Color = RGB(255, 255, 0)
    
                 Set rCell = Nothing
            End If
        Next fCell
              
    End Sub
    Trying to alter so that
    Set FindRng = .Range("AA2:AA" & lRow2)
    become a list
    aryFind = Array("Bounced", "NotStarted", "Incomplete", "AddedName")
    But I am not getting the For loop
     For f = 0 To UBound(aryFind)
    to work I do not get all the matches I should be getting

    Thanks
    Sub FindMatchesFromList()
    Dim PostBackWS As Worksheet
    Dim aryFind As Variant
    Dim ReplaceRng As Range, rCell As Range
    Dim f As Long, lRow As Long
        
        
        aryFind = Array("Bounced", "NotStarted", "Incomplete", "AddedName")
    
         With ThisWorkbook.Sheets("Helper")
                lRow = .Range("A" & .Rows.Count).End(xlUp).Row
                Set ReplaceRng=  .Range("AA2:AA" & lRow2)
           End With
        
        Set PostBackWS = ThisWorkbook.Sheets("XXX")
         
        For Each rCell In ReplaceRng
           For f = 0 To UBound(aryFind)
            Set rCell = ReplaceRng.Find(aryFind(f), , xlValues, xlWhole, xlByRows, xlNext, MatchCase:=False)
               If Not rCell Is Nothing Then
    
                 PostBackWS.Range(rCell.Address).Offset(0, 1).Value = rCell.Value
                 'Set Interior Color for Matches
                 PostBackWS.Range(rCell.Address).Offset(0, 0).Interior.Color = RGB(255, 255, 0)
    
               End If
            Next f
           Set rCell = Nothing
        Next rCell
              
    End Sub
    Last edited by capson; 09-14-2015 at 02:21 PM.

  2. #2
    Forum Contributor
    Join Date
    07-11-2010
    Location
    Minneapolis, USA
    MS-Off Ver
    Excel 2016
    Posts
    308

    Re: Alter Matching Sub From matching two Ranges to matching one range and list

    I solved it this way

    Sub FindMatchesFromList()
    Dim PostBackWS As Worksheet
    Dim aryFind As Variant
    Dim LookInRng As Range, rCell As Range
    Dim f As Long, lRow As Long
        
        
        aryFind = Array("Bounced", "NotStarted", "Incomplete", "AddedName")
    
         With ThisWorkbook.Sheets("Helper")
                lRow = .Range("A" & .Rows.Count).End(xlUp).Row
                Set LookInRng = .Range("AA2:AA" & lRow)
           End With
        
        Set PostBackWS = ThisWorkbook.Sheets("XXX")
         
        For Each rCell In LookInRng
           For f = 0 To UBound(aryFind)
    
              If MatchExists (aryFind(f), rCell) = True Then
                   PostBackWS.Range(rCell.Address).Offset(0, 1).Value = rCell.Value
                   'Set Interior Color for Matches
                   PostBackWS.Range(rCell.Address).Offset(0, 1).Interior.Color = RGB(255, 255, 0)
    
              Else
             
              End If
    
            Next f
           Set rCell = Nothing
        Next rCell
              
    End Sub
    Function MatchExists (ByVal searchName As String, nameRange As Range) As Boolean
        MatchExists = Not nameRange.Find(searchName, , xlValues, xlWhole, xlByRows, xlNext, MatchCase:=False) Is Nothing
    End Function
    Last edited by capson; 09-14-2015 at 11:26 PM.

+ Reply to Thread

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Similar Threads

  1. Finding Matching Data in one Column/Adding corresponding matching string value.
    By swade730 in forum Excel Programming / VBA / Macros
    Replies: 1
    Last Post: 10-02-2013, 07:23 PM
  2. Indexing and matching data from date range and matching
    By Rickomicko in forum Excel Formulas & Functions
    Replies: 2
    Last Post: 06-19-2013, 11:46 AM
  3. Matching Data between Files , Deleting Matching Rows
    By nem_vdoxx in forum Excel Programming / VBA / Macros
    Replies: 5
    Last Post: 05-20-2013, 11:00 AM
  4. Replies: 2
    Last Post: 04-11-2013, 11:14 AM
  5. SQL Query to get count of matching & non-matching data from two tables
    By Kiran2012 in forum Excel Programming / VBA / Macros
    Replies: 0
    Last Post: 03-13-2013, 10:32 PM
  6. [SOLVED] Compare a range with previous ranges and count matching numbers
    By sans in forum Excel General
    Replies: 29
    Last Post: 05-01-2012, 09:33 AM
  7. Bank reconciliation - Many to one matching and partial cell matching
    By maartendelaet in forum Excel Programming / VBA / Macros
    Replies: 12
    Last Post: 01-25-2010, 08:21 PM
  8. [SOLVED] Range matching multiple named Ranges
    By ben simpson in forum Excel General
    Replies: 0
    Last Post: 03-15-2006, 02:50 PM

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1