VBA to lookup for a specific value and give result

**winmaxservices** · 11-09-2015, 04:58 AM

I Have a workbook with 2 sheets " Acct. Details" and "Manual Checking"
In sheet "Manual Checking" have a column F (UTR NO.2) which contains digits.

Check the same digits in Sheet "Acct. Details" in column C (Particulars).
If string in C of Sheet "Acct. Details" contains the Digits of Column F of Sheet "Manual Checking" then in column "I" in "Manual Checking" should show SR. no. (Column D) from Acct Details.
If the digits are not exists the result should be "No Sr."

For example please refer sheet "Result Needed". Required result marked in grey colour

**JOHN H. DAVIS** · 11-09-2015, 08:23 AM

Maybe:

Sub winmaxservicesz()
Dim ws As Worksheet, ws1 As Worksheet, i As Long, x As Range
Set ws = Sheets("MANUAL CHECKING")
Set ws1 = Sheets("ACCT.DETAILS")
With ws
    For i = 2 To .Range("F" & Rows.Count).End(3).row
        Set x = ws1.Columns(3).Find(.Cells(i, "F"), LookIn:=xlValues, Lookat:=xlPart)
            If Not x Is Nothing Then
                .Cells(i, "I") = x.Offset(, 1)
            End If
        Set x = Nothing
    Next i
End With
        
End Sub

**winmaxservices** · 11-09-2015, 09:39 AM

Hi, Its working, but it not working on duplicate entries

There are some number from sheet "Manual Checking" in a column F (UTR NO.2) which contains digits. has multiple records in Sheet "Acct. Details" in column C (Particulars).

If there is more than one entry the SR number should be more than one and should be seprated by "^". Please refer attachment sheet "result needed", example marked in Orange colour

For an example:

The number "299463012" in Column F of sheet "Manual Checking" contains in column C of sheet "ACCT. DETAILS" for 2 times hence the SR number is "5385^4888"

The number "26260857" in Column F of sheet "Manual Checking" contains in column C of sheet "ACCT. DETAILS" for 3 times hence the SR number is "1766^4211^9089"

can you please change the code accordingly?

**JOHN H. DAVIS** · 11-09-2015, 10:49 AM

Try:

Sub winmaxservicesz()
Dim ws As Worksheet, ws1 As Worksheet, i As Long, x As Range, y As String, z As Long
Set ws = Sheets("MANUAL CHECKING")
Set ws1 = Sheets("ACCT.DETAILS")
y = ""
With ws
    For i = 2 To .Range("F" & Rows.Count).End(3).row
        For Each x In ws1.Range("C2:C" & ws1.Range("C" & Rows.Count).End(3).row)
           If x.Value Like "*" & .Cells(i, "F") & "*" Then
                y = y & x.Offset(, 1) & "^"
                .Cells(i, "I") = y
            End If
            y = y
        Next x
        y = ""
        If .Cells(i, "I") = "" Then
            .Cells(i, "I") = "No Sr."
            GoTo zz
        End If
        If .Cells(i, "I") <> "" Then
        .Cells(i, "I") = Left(.Cells(i, "I"), Len(.Cells(i, "I")) - 1)
        For z = 3 To 5
        If Left(Cells(i, "I"), z) = Right(Cells(i, "I"), z) Then Cells(i, "I") = Left(Cells(i, "I"), z)
        Next z
        End If
zz:
        .Cells(i, "I").HorizontalAlignment = xlLeft
    Next i
End With

**winmaxservices** · 11-10-2015, 02:24 AM

Hi, Your code works perfectly.
I am new to VBA. Can you please explain the code that how it works? means functions of each line by line. Just for my knowledge.

Thanks

**winmaxservices** · 11-13-2015, 01:34 AM

Hi, I checked the code. But it is not working for few cells.

Please find attached workbook.
in Sheet Manual Checking Cell "I7" should show 30303, but shows only 303. Because SRL No.in sheet "ACCT.DETAILS is 30303
in Sheet Manual Checking Cell "I8" should show 28282, but shows only 282. Because SRL No.in sheet "ACCT.DETAILS is 28282

Can you please check and revert with changes in code

**jindon** · 11-09-2015, 11:30 AM

winmaxservices

The results are bit different...

Sub tset()
    Dim a, b, i As Long, e
    Dim dic As Object, m As Object
    Set dic = CreateObject("Scripting.Dictionary")
    With Sheets("manual checking").Cells(1).CurrentRegion
        .Offset(1).Columns(9).ClearContents
        a = .Value
        For i = 2 To UBound(a, 1)
            e = CStr(a(i, 6))
            dic(e) = dic(e) & IIf(dic(e) <> "", ",", "") & i
        Next
        b = Sheets("ACCT.DETAILS").Cells(1).CurrentRegion.Value
        With CreateObject("VBScript.RegExp")
            .Global = True
            .Pattern = Join(dic.keys, "|")
            For i = 2 To UBound(b, 1)
                If .test(b(i, 3)) Then
                    For Each m In .Execute(b(i, 3))
                        For Each e In Split(dic(m.Value), ",")
                            a(e, 9) = a(e, 9) & IIf(a(e, 9) <> "", "^", "") & b(i, 4)
                        Next
                    Next
                End If
            Next
        End With
        .Value = a
    End With
End Sub

**Keebellah** · 11-09-2015, 11:32 AM

I think this one does what you need.
It's a modified macro using John's macro
The macro to run: Modifiedwinmaxservicesz

**LeoTaxi** · 11-09-2015, 02:16 PM

do i mis something or is there a reasen ?

row 52 Nr 15299483 in your sheet needed result = 6037

but rows 38,43 en 47 have also Nr 15299483 in column C

Kind regards
Leo

**Keebellah** · 11-09-2015, 04:32 PM

There are 41 values in column F that occurs more than once, but that's the OP's problem

8 occur 4 times
9 occur 3 times
24 occur 2 times

**Keebellah** · 11-10-2015, 04:27 PM

Here's the code with comments:


Public Sub Modifiedwinmaxservicesz()
Dim ws      As Worksheet            '*  variable to refer to one worksheet in this case Manual checking
Dim ws1     As Worksheet            '*  variable to refer tto the other worksheet
Dim x       As Range                '*  a variable declared as range e.g: a cell range
Dim lstRow  As Long                 '*  a variable to hold the last filled row
Dim rng     As Range                '*
Dim frng    As Range                '*  a variable declared as range e.g: a cell range
Dim fRec    As Long                 '*  variable to hold the found row number when search for the first ocurrence

Set ws = Sheets("MANUAL CHECKING")  '*  declare the reference to a worksheet
Set ws1 = Sheets("ACCT.DETAILS")    '*  declare the reference to a worksheet
lstRow = WorksheetFunction.Max(2, ws.Range("F" & Rows.Count).End(xlUp).Row)     '*  find the lastfilled row in column F
                                '*  I always include the max row number in this case row 2 in case column F is empty
ws.Range("I2:I" & lstRow).ClearContents             '*  clear column I contents
Application.ScreenUpdating = False                  '*  turn screen updating off to speed up processing
For Each x In ws.Range("F2:F" & lstRow)             '*  loop to go trhough each cell (range) in Column F
    Application.StatusBar = "Processing ... " & Format(x.Row / lstRow, "#0#%")      '*  update the Statusbar to show progress, just informative
    fRec = 0                                        '*  set the record found value to 0
    With ws1.Range("C:C")                           '*  in the owther worksheet set the serach range to Column C 'Particulars'
        Set rng = .Find(What:=x.Value, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)  '*  find if the value in F is present in column C
        If Not rng Is Nothing Then                  '*  if the value is found (Not Nothing means that it is not empty)
            fRec = rng.Row                          '*  store the first found row number in the variable
            Do                                      '*  start the Do while loop for the same value
                If Len(Trim(ws.Cells(x.Row, "I").Value)) > 0 Then ws.Cells(x.Row, "I").Value = ws.Cells(x.Row, "I").Value & "^"     '*  if value is found check if the cell in I is already empty if not add the ^
                ws.Cells(x.Row, "I").Value = ws.Cells(x.Row, "I").Value & rng.Offset(0, 1).Value    '*  add the value next to particulars
                Set rng = .FindNext(rng)            '*  find the next ocurrence
            Loop While Not rng Is Nothing And rng.Row <> fRec   '*  Loop while the ocurrence is found and the row number is different than the first found row
        Else                                        '*  if no ocurrence is found
            ws.Cells(x.Row, "I").Value = "No Sr."   '*  place the value 'No. Sr' in cloumn I
        End If
    End With
Next x                                              '*  the next range
Application.ScreenUpdating = True                   '*  turn screen updating back on
With ws.Range("I:I")                                '*  autofit column I and allign all values to the left
    .Columns.AutoFit
    .HorizontalAlignment = xlLeft
End With
Application.StatusBar = False                       '*  turn status bar back off
End Sub

It's really all just a step by stpe do this if that else something else

**Keebellah** · 11-13-2015, 04:29 AM

Why are you not using my code?
It works if you use the code where you asked me to add comments and explain it.
The attached file does not contain my vba code so it doesn't work!

VBA to lookup for a specific value and give result

LinkBack

Thread Tools

Rate This Thread

Display

Hybrid View

VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Re: VBA to lookup for a specific value and give result

Thread Information

Users Browsing this Thread

Similar Threads

Need Formula to lookup for specific text in a string and give desired output.

Lookup and place result in specific cell

[SOLVED] Lookup multiple criteria in table and give row + culmn as result

need a lookup formula to return a specific result...

[SOLVED] i have multiple lookup in my excel, its give result "0" i want blank outpu.

LOOKUP does not always give the correct result - correct number of vectors etc checked

Lookup/Find Sheet then give value of specific cell within sheet

Bookmarks

Bookmarks

Posting Permissions