Error in finding the matched ID - vba

Question

I have two Sheets sheet1, sheet2
With sheet1 i have id which always starts with 4, I look for this ID in sheet2, and pul the corresponding names and copy back to sheet1.
The ID is always 8 Digit Long.
during this , I have an Special case, where an ID has some Special charachters and charachters. eg: 41017734_dr_bad ; the code Fails in this case. I doesnot recognise the first 8 and Fails to paste in the another sheet.
Could someone suggest how to overcome this?
I have an idea we could use whilcard and also strlen function. But struck how to use in code.
Sub match()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim cell As Range, cell2 As Range, lstcl As Variant, lstcl2 As Variant, rgFnd As Variant
Dim n As Double, ID As String
Set sh1 = ThisWorkbook.Sheets("S")
Set sh2 = ThisWorkbook.Sheets("P")
ID = "4"
lstcl = sh1.Range("N10000").End(xlUp).Row
lstcl2 = sh2.Range("L10000").End(xlUp).Row
'comparing columns N and L in both sheets
For Each cell In sh2.Range("L5:L" & lstcl2)
For n = 5 To lstcl
If cell = sh1.Range("N" & n) Then
'the cell in column M next to the matching cell is equal to the 4xxxxxxx number
cell.Offset(0, 1) = sh1.Range("N" & n)
'the next cell in column N is equal to the A2C number in column A
cell.Offset(0, 2) = cell.Offset(0, -11)
End If
Next
Next
'test that each cell in the first sheet corresponds to the located results in the second sheet _
'and pastes back the A2C number, using the Range.Find function
For Each cell2 In sh1.Range("N5:N" & lstcl)
If Left(cell2, 1) = ID Then
Set rgFnd = sh2.Range("M5:M" & lstcl2).Find(cell2.Value)
If Not rgFnd Is Nothing Then
cell2.Offset(0, 1) = sh2.Range(rgFnd.Address).Offset(0, 1)
End If
End If
Next
End Sub

Answer 1

Try this
Sub match()
Dim sh1 As Worksheet, sh2 As Worksheet
Dim cell As Range, cell2 As Range, lstcl As Variant, lstcl2 As Variant, rgFnd As Variant
Dim n As Double, ID As String
Set sh1 = ThisWorkbook.sheets("S")
Set sh2 = ThisWorkbook.sheets("P")
ID = "4"
lstcl = sh1.Range("N10000").End(xlUp).Row
lstcl2 = sh2.Range("L10000").End(xlUp).Row
'comparing columns N and L in both sheets
For Each cell In sh2.Range("L5:L" & lstcl2)
For n = 5 To lstcl
a = Left(sh1.Range("N" & n), 8)
If cell = a Then
'the cell in column M next to the matching cell is equal to the 4xxxxxxx number
cell.Offset(0, 1) = a
'the next cell in column N is equal to the A2C number in column A
cell.Offset(0, 2) = cell.Offset(0, -11)
End If
Next
Next
'test that each cell in the first sheet corresponds to the located results in the second sheet _
'and pastes back the A2C number, using the Range.Find function
For Each cell2 In sh1.Range("N5:N" & lstcl)
If Left(cell2, 1) = ID Then
Set rgFnd = sh2.Range("M5:M" & lstcl2).Find(cell2.Value)
If Not rgFnd Is Nothing Then
cell2.Offset(0, 1) = sh2.Range(rgFnd.Address).Offset(0, 1)
End If
End If
Next
End Sub