Thread: Macros to match two values in two worksheets and output it

It looks like you may have to write your own string parser for this. In the examples that you have given, there are two instances of the string AT#G#####.#. Are there cases where there are one or more than two? If there is only one, will it always be in the early part of the string, so you would consider it a match? What happens if there are three? Are you interesting in the match at the beginning of the string only? If the format of the data is like you have given, maybe a simple match at position 11 would do.

Post a workbook with some examples?

Hello Fyre182,

VBA can parse the strings using VBScript's Regular Expressions. This is both a powerful and flexible tool for extracting this type of data. You should post a sample workbook. Be sure it matches the layout of the original and provide several hundred samples. This will insure the code will work properly.

Uploaded an example

Upload feature seems to not be working

so I have provided the data in a google worksheet

should be easy to copy and paste to excel

http://spreadsheets.google.com/ccc?k...QTkxSS3c&hl=en

Hello Fyre182,

I downloaded the workbook from Google and ran the macro the check that it works. The macro below has been added to the attached worksheet. There is button on Sheet3 to run the macro.

Data Parsing Macro

Code:

'Written: March 18, 2010
'Author:  Leith Ross

Sub ParseData()

  Dim Data() As Variant
  Dim DSO As Object
  Dim DstWks As Worksheet
  Dim Key As Variant
  Dim Keys As Variant
  Dim RegExp As Object
  Dim R As Long
  Dim Rng As Range
  Dim RngEnd As Range
  Dim SrcWks As Worksheet
  
    Set SrcWks = Worksheets("Sheet1")
    Set DataWks = Worksheets("Sheet2")
    Set DstWks = Worksheets("Sheet3")
    
    Set Rng = SrcWks.Range("A1")
    Set RngEnd = SrcWks.Cells(Rows.Count, Rng.Column).End(xlUp)
    
   'Exit if there is no data
    If RngEnd.Row = 1 And IsEmpty(RngEnd) Then Exit Sub
    
      Set Rng = SrcWks.Range(Rng, RngEnd)
      
     'Create the search array
      Set DSO = CreateObject("Scripting.Dictionary")
      DSO.CompareMode = vbTextCompare
      
       'Fill the search array
        For Each Key In Rng
          Key = Trim(Key)
          If Key <> "" Then
            If Not DSO.Exists(Key) Then DSO.Add Key, ""
          End If
        Next Key
          
         'Create parsing object
          Set RegExp = CreateObject("VBScript.RegExp")
          RegExp.IgnoreCase = True
          RegExp.Pattern = "^(\w+)(\s\w+\.\d)(\s.*)"
        
         'Get the size the parsing data range
          Set Rng = DataWks.Range("A1")
          Set RngEnd = DataWks.Cells(Rows.Count, Rng.Column).End(xlUp)
          
         'Exit if there is no data
          If RngEnd.Row = 1 And IsEmpty(RngEnd) Then Exit Sub
          
          Set Rng = DataWks.Range(Rng, RngEnd)
          
         'Fill the search array with data
          ReDim Data(1 To Rng.Rows.Count, 1 To 1)
          Data = Rng.Value
      
           'Clear the detination worksheet
            DstWks.Cells.ClearContents
          
           'Copy data to destination worksheet if parsed data matches
            For Each Key In Data
              Key = LTrim(RegExp.Replace(Key, "$2"))
              If DSO.Exists(Key) Then
                 R = R + 1
                 DstWks.Cells(R, "A") = Key
              End If
            Next Key
            
   'Free objects and memory
    Set DSO = Nothing
    Set RegExp = Nothing
          
End Sub

Hello Fyre182,

Sorry for delayed response. My ISP went down today about noon and now just came back up. All that needs to be changed is the Pattern property of the Regular Expression. The pattern below will now only match if there are 2 alpha characters followed by 1 digit, 1 or more alphanumeric characters, 1 period, and 1 digit. I have added this change to the attached workbook.

Code:

    RegExp.Pattern = "^(\w+)(\s\w{2}\d\w+\.\d)(\s.*)"