String Comparison Help needed (Simple I hope)

[Tim H]

Hello,

I have 2 sets of data and need to see if the SSN from the first sheet is
existant in the other and if so Copy that cell and paste it in a third sheet.
first 9 Characters in first sheet are SSN, Characters 7-15 are the SSN on
second sheet.

Sheets("Compiled").Select
Range("A1").Select
For i = 1 To 1500
Sheets("Compiled").Select
Keyy = Cells(i, 1).Value
Keyy2 = Mid(Keyy, 1, 9)
Typ = Cells(i, 2).Value
If Keyy = "" Then
EmptyRowCounter = EmptyRowCounter + 1
GoTo Skip
Else
EmptyRowCounter = 0
Sheets("Compare").Select
Range("A1").Select
For z = 1 To 2500
SSN = Cells(i, 1).Value
SSN2 = Mid(SSN, 7, 9)
If SSN2 = Keyy2 Then
Message = SSN
Sheets("OUTPUT").Select
Rows("1:1").Select
Selection.Insert Shift:=xlDown
Cells(1, 1).Value = Message
End If
Next
End If
Skip:
If EmptyRowCounter = 20 Then GoTo Endd
Next
Endd:
Sheets("Compiled").Select
Range("A1").Select
End Sub

Sample Data

1st list SSN = 1-9: "123456789200701012315446"
2nd list SSN = 7-15: " 123456789200712122556000000.0000022554.35.000000"

Any help would be greatly appreciated

All The Best,

Tim

 

[Jason Lepack]

Tim,

This is a little bit cleaner code that functions as far as I can tell.
As I'm posting this I notice that you have row gaps, is this true? Are
they in both sheets? I can fix that tonight if this is true.

Public Sub TimH()
Dim wb As Workbook
Dim wsCompare As Worksheet, wsCompile As Worksheet, wsOutput As
Worksheet
Dim rCompare As Range, rCompile As Range, rOutput As Range

' Initialize the worksheets for the ranges
Set wb = ActiveWorkbook
Set wsCompare = wb.Sheets("Compare")
Set wsCompile = wb.Sheets("Compiled")
Set wsOutput = wb.Sheets("Output")

' Initialize the output
Set rOutput = wsOutput.Range("A1")
rOutput.EntireColumn.NumberFormat = "@" ' Text

' This will loop through all values in the Compiled worksheet
Set rCompile = wsCompile.Range("A1")
Do While Not rCompile.Value = ""

' This will compare all values in Compiled to Compare until there's a
match
Set rCompare = wsCompare.Range("A1")
Do While Not Mid(rCompare.Value, 7, 9) = Left(rCompile.Value,
9) And Not rCompare.Value = ""
Set rCompare = rCompare.Offset(1, 0)
Loop
' If it found a match then add it to the output sheet, otherwise ignore
If Not rCompare.Value = "" Then
rOutput.Value = Mid(rCompile.Value, 1, 9)
Set rOutput = rOutput.Offset(1, 0)
End If
Set rCompile = rCompile.Offset(1, 0)
Loop

' Clean up the instance variables
Set rOutput = Nothing
Set rCompare = Nothing
Set rCompile = Nothing
Set wsOutput = Nothing
Set wsCompare = Nothing
Set wsCompile = Nothing
Set wb = Nothing
End Sub

Cheers,
Jason Lepack

 

[Tim H]

Hi Jason,

Thanks a bunch! This is working loads better. There will be Blank rows in
only the first sheet, and the output needs to be the entire cell in the
second list ("compare" sheet) if a match is found.

Thanks again for all your help!

Tim

 

[Jason Lepack]

Blanks in the "Compare" sheet or the "Compiled" sheet?

And if I could ask a "stupid" question... Why do you have the 6 leading
spaces?

Cheers,
Jason Lepack