Consulting

Page 2 of 2 FirstFirst 1 2
Results 21 to 29 of 29

Thread: Need an advice for searching function

  1. #21
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Test this:
    Sub blah()
    Dim AllCodes(), Addresses(), FoundCells As Range
    ReDim AllCodes(1 To 1)
    ReDim Addresses(1 To 1)
    For Each cll In Sheets("Product Sample").Columns(1).SpecialCells(2).Cells
      'Debug.Print cll.Address(0, 0), cll.Value
      cll.Value = Replace(cll.Value, " ", "")
      zz = Split(cll.Value, "-")
      If UBound(zz) = 0 Then zz = Split(cll.Value, ",")  'either it's split with - or comma, not both.
      ' Debug.Assert cll.Row <> 56
      Select Case UBound(zz)
        Case 0
          'Debug.Print zz(0), cll.Address(0, 0)
          J = J + 1
          ReDim Preserve AllCodes(1 To J)
          ReDim Preserve Addresses(1 To J)
          AllCodes(J) = zz(0)
          Addresses(J) = cll.Address(0, 0)
        Case Is > 0
          'Stop
          Dim RegEx As Object
          Set RegEx = CreateObject("VBScript.RegExp")
          RegEx.Global = True
          RegEx.Pattern = "[A-Za-z]"
          zz(UBound(zz)) = RegEx.Replace(zz(UBound(zz)), "")
          DigitCount = Len(zz(UBound(zz)))
    
          For i = CLng(Right(zz(0), DigitCount)) To CLng(zz(UBound(zz)))
            'Debug.Print Left(zz(0), Len(zz(0)) - DigitCount) & Format(i, Left("000000000", DigitCount)), cll.Address(0, 0)
            J = J + 1
            ReDim Preserve AllCodes(1 To J)
            ReDim Preserve Addresses(1 To J)
            AllCodes(J) = Left(zz(0), Len(zz(0)) - DigitCount) & Format(i, Left("000000000", DigitCount))
            Addresses(J) = cll.Address(0, 0)
          Next i
      End Select
    Next cll
    Debug.Print J
    FindMe = Sheets("UserForm Search").TextBox1.Value
    For i = LBound(AllCodes) To UBound(AllCodes)
      If AllCodes(i) = FindMe Then
        If FoundCells Is Nothing Then
          Set FoundCells = Sheets("Product Sample").Range(Addresses(i))
        Else
          Set FoundCells = Union(FoundCells, Sheets("Product Sample").Range(Addresses(i)))
        End If
      End If
    Next i
    If Not FoundCells Is Nothing Then
    Application.Goto FoundCells
    MsgBox FindMe & " found in cells " & FoundCells.Address(0, 0)
    Else
    MsgBox "Not found"
    End If
    End Sub
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  2. #22
    Hi, Can you explain this for me, I am not clear at this, why must using Union.
    Set FoundCells =Union(FoundCells, Sheets("Product Sample").Range(Addresses(i)))
    When finding this "7103A403" , this returns as below ( A2:A3,A7), the result "A7" is correct , and the '7103A346' must returns "A3" , not "A2:A3".

    vb.jpg
    Last edited by rong3; 11-12-2017 at 07:09 PM.

  3. #23
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    As far as I can see A2 is also correct; the prefix 7103A is correct and 403 is in the range 345 to 438.
    When looking for 346, that too is in A2 and A3; the 2nd element of A2 and the 1st of A3.
    UNION so that I can select them at the end to show where they are rather than loop through them one at a time. You don't have to use it.

  4. #24
    Quote Originally Posted by p45cal View Post
    As far as I can see A2 is also correct; the prefix 7103A is correct and 403 is in the range 345 to 438.
    When looking for 346, that too is in A2 and A3; the 2nd element of A2 and the 1st of A3.
    UNION so that I can select them at the end to show where they are rather than loop through them one at a time. You don't have to use it.
    Oh seems I am not explain clearly the symbol "-", sorry for taking your time, but the "7103A345-438" is only 2 elements that stands for "7103A345" and "7103A438", it is not a range from 345 to 438.
    Can you help me to fix it? Thanks too much.

  5. #25
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by rong3 View Post
    Oh seems I am not explain clearly the symbol "-", sorry for taking your time, but the "7103A345-438" is only 2 elements that stands for "7103A345" and "7103A438", it is not a range from 345 to 438.
    Can you help me to fix it? Thanks too much.
    oh groan… and what does the comma mean? How many elements in 7103A111,120?
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  6. #26
    Quote Originally Posted by p45cal View Post
    oh groan… and what does the comma mean? How many elements in 7103A111,120?
    All the code of product is format by "-", if you see others like "," or "->" it will be replaced in code to "-", so it not a range as you think.
    How many elements in 7103A111,120? It just 2 that stands for 7103A111 and 7103A120.

  7. #27
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Quote Originally Posted by rong3 View Post
    Can you help me to fix it?
    Yes, I'll get round to it soon.
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  8. #28
    Knowledge Base Approver VBAX Wizard p45cal's Avatar
    Joined
    Oct 2005
    Location
    Surrey UK
    Posts
    5,844
    Test the following which is in the attached.
    Sub blah()
    Dim AllCodes(), Addresses(), FoundCells As Range
    ReDim AllCodes(1 To 1)
    ReDim Addresses(1 To 1)
    For Each cll In Sheets("Product Sample").Columns(1).SpecialCells(2).Cells
      cll.Value = Replace(cll.Value, " ", "")
      zz = Split(cll.Value, "-")
      If UBound(zz) = 0 Then zz = Split(cll.Value, ",")  'either it's split with - or comma, not both.
      Select Case UBound(zz)
        Case Is >= 0
          J = J + 1
          ReDim Preserve AllCodes(1 To J)
          ReDim Preserve Addresses(1 To J)
          AllCodes(J) = zz(0)
          Addresses(J) = cll.Address(0, 0)
          If UBound(zz) > 0 Then
            For i = 1 To UBound(zz)
              J = J + 1
              ReDim Preserve AllCodes(1 To J)
              ReDim Preserve Addresses(1 To J)
              AllCodes(J) = Mid(zz(0), 1, Len(zz(0)) - Len(zz(i))) & zz(i)
              Addresses(J) = cll.Address(0, 0)
            Next i
          End If
      End Select
    Next cll
    FindMe = Sheets("UserForm Search").TextBox1.Value
    For i = LBound(AllCodes) To UBound(AllCodes)
      If AllCodes(i) = FindMe Then
        If FoundCells Is Nothing Then
          Set FoundCells = Sheets("Product Sample").Range(Addresses(i))
        Else
          Set FoundCells = Union(FoundCells, Sheets("Product Sample").Range(Addresses(i)))
        End If
      End If
    Next i
    If Not FoundCells Is Nothing Then
      Application.Goto FoundCells
      MsgBox FindMe & " found in cells " & FoundCells.Address(0, 0)
    Else
      MsgBox "Not found"
    End If
    End Sub
    Attached Files Attached Files
    p45cal
    Everyone: If I've helped and you can't be bothered to acknowledge it, I can't be bothered to look at further posts from you.

  9. #29
    Thank you @p45cal so much, it works perfectly now.

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •