CODEWITHSUNDEEP
vbaexcel
Mikz
Mikz

Reputation: 591

Extracting a particular information from a cell

I have a sheet, S and P. In Sheet S, I have few ID starting with D2E and few Id starting with 4 in Column N.

I am comparing the ID, containing 4, with sheet P in column L. If they match, then I am writing the ID of sheet P from column A in Column N.

I have few case below in the snapshot, which I am not able to extract. Could any one help me , how I can do that

In sheet S , I have an Id like 41035036_drw_000_draf , in sheet P I am able to find the corresponding D2E number and I got it printed, but I want this number to be printed in my sheet S of column P.

I believe that I need to modify the rng.find function. that I it looks for first 8 character. Could any one help, how I can do that

Below is my code

Sub drwmatch()
    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
    Dim a As String
    Dim b As Variant

    Set sh1 = ThisWorkbook.Sheets("S")
    Set sh2 = ThisWorkbook.Sheets("P")

    ' ID starts with number 4
    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" & n)
        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

Upvotes: 0

Views: 46

Answers (1)

h2so4
h2so4

Reputation: 1577

to have a search on the first 8 chars you could write your find instruction like this

Set rgFnd = sh2.Range("M5:M" & lstcl2).Find(Left(cell2.Value, 8), lookat:=xlPart)

Upvotes: 1

Related Questions