Results 1 to 2 of 2
  1. #1
    5 Star Lounger jujuraf's Avatar
    Join Date
    Jun 2001
    San Jose, California, USA
    Thanked 0 Times in 0 Posts
    I have a spreadshee with about 3200 rows (and cols A-AJ - not all populated). I need to search for all records that match a given pattern and copy data from one cell to another. The gotcha is that the identical cols to test start from H so I don't want to start from A. Once I find a match, I have to copy the data from col D into the other record's col D (which will be empty). There will probably only be one match (one pair of records) but I can't guarantee it. The goal is to populate an empty field of the matching row with the same data from its mate.

    I attached a simplified sample with original data and sample output (data to be matched is col's H to AJ only)

    CC yes no yes yes
    empty yes no yes yes
    DD no yes yes no
    empty yes no yes yes

    For this very simplified table, I want to add 'CC" to row 2 since it's an exact match to row 1. I do nothing to row 3 since it doesn't match anything. I also only test rows which have data in col D (the "CC" and 'DD" field). The comparison only occurs from col H onward. The data to be copied (after a match is found) is located in col D.

    Should I copy all the data to a new sheet and concatenate the col's to do a single comparison (instead of cell by cell)?
    Attached Files Attached Files

  2. #2
    Plutonium Lounger
    Join Date
    Mar 2002
    Thanked 31 Times in 31 Posts
    Here is a macro you could use. It'll be slow though.

    Sub FillMatch()
      Const lngCol1 = 2 ' column to fill
      Const lngCol2 = 3 ' first column to compare
      Const lngCol3 = 5 ' last column to compare
      Const lngStart = 10
      Dim lngEnd As Long
      Dim s As Long
      Dim t As Long
      Dim c As Long
      Dim blnMatch As Boolean
      Application.ScreenUpdating = False
      ' Last row
      lngEnd = Cells.Find(What:="*", SearchOrder:=xlByRows, _
      ' Loop through rows
      For s = lngStart To lngEnd - 1
    	' Cell in first column should not be blank
    	If Not Cells(s, lngCol1).Value = "" Then
    	  ' Try to find a match
    	  For t = lngStart + 1 To lngEnd
    		' Cell in first column should be blank
    		If Cells(t, lngCol1).Value = "" Then
    		  blnMatch = True
    		  ' Loop through columns
    		  For c = lngCol2 To lngCol3
    			' Compare
    			If Not Cells(t, c).Value = Cells(s, c).Value Then
    			  ' No match - exit loop
    			  blnMatch = False
    			  Exit For
    			End If
    		  Next c
    		  If blnMatch Then
    			' Match found, copy cell in first column
    			Cells(t, lngCol1).Value = Cells(s, lngCol1).Value
    		  End If
    		End If
    	  Next t
    	End If
      Next s
      Application.ScreenUpdating = True
    End Sub

Posting Permissions

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