Consulting

Results 1 to 8 of 8

Thread: May be MID and Find function

  1. #1
    VBAX Contributor
    Joined
    Jun 2008
    Posts
    169
    Location

    May be MID and Find function

    Hi, all

    how do i convert the formula like "=MID(D5,FIND("E",D5)+1,5)" to using in my macros below :

    [VBA]LR = Range("C" & Rows.Count).End(xlUp).Row
    For R = 1 To LR
    If Cells(R, 4).Value Like "*" & "STATUS CODE" & "*" Then
    Sheet2.Cells(IndexI, 4).Value =" the mid and fing formula "
    End If
    Next R
    [/VBA]

    actually loop the wording is "STATUS CODE 92 * DADS# 06 * " but i just only want the code "92"

    experts kindly help and learn me more thxx

  2. #2
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    Greetings KK1966,

    I'm not sure, but if I am grasping the pattern you want to match, maybe something like:

    In a Standard Module:
    [VBA]Option Explicit

    Sub example()
    Dim REX As Object
    Dim rngSource As Range
    Dim rngDest As Range
    Dim arr_vntValues() As Variant
    Dim lDestRow As Long
    Dim n As Long

    '// Find last cell in source column; presumes a header row in row 1. //
    Set rngSource = RangeFound(Sheet1.Range(Sheet1.Cells(2, 1), Sheet1.Cells(Sheet1.Rows.Count, 1)))

    '// If no data, bail... //
    If rngSource Is Nothing Then
    MsgBox "No values"
    Exit Sub
    End If

    '// If data, reset range from row 2 to last row w/data. //
    Set rngSource = Sheet1.Range(Sheet1.Cells(2, 1), rngSource)

    '// Return first row with no data in destination. //
    Set rngDest = RangeFound(Sheet2.Range(Sheet2.Cells(2, 1), Sheet2.Cells(Sheet2.Rows.Count, 1)))
    If rngDest Is Nothing Then
    lDestRow = 2
    Else
    lDestRow = rngDest.Row + 1
    End If

    '// Just in case only one row of data, so no hiccup whne we go to loop the array. //
    If rngSource.Rows.Count = 1 Then
    ReDim arr_vntValues(1 To 1, 1 To 1)
    arr_vntValues(1, 1) = rngSource.Value
    Else
    arr_vntValues = rngSource.Value
    End If


    Set REX = CreateObject("VBScript.RegExp")
    With REX
    '// Presuming only one return per cell //
    .Global = False
    .IgnoreCase = False
    '// Create pattern as desired. This one is looking for one match made of two //
    '// sub-expressions. The first is "STATUS', followed by zero to two spaces, //
    '// followed by "CODE", followed by zero to two spaces. The second sub- //
    '// expression is 1 to many digits. If we Match, then we just want the second //
    '// sub-expression returned. //
    .Pattern = "(STATUS {0,2}CODE {0,2})(\d+)"
    For n = 1 To UBound(arr_vntValues, 1)
    '// Test first, so that .Execute doesn't botch if no Match. //
    If .Test(arr_vntValues(n, 1)) Then
    '//If success, return the value. I tacked in including which row it was//
    '// found in. //
    Sheet2.Cells(lDestRow, 1).Value = _
    "In Row: " & n + 1 & _
    " I found: " & .Execute(arr_vntValues(n, 1))(0).SubMatches(1)
    lDestRow = lDestRow + 1
    End If
    Next
    End With
    End Sub

    Function RangeFound(SearchRange As Range, _
    Optional ByVal FindWhat As String = "*", _
    Optional StartingAfter As Range, _
    Optional LookAtTextOrFormula As XlFindLookIn = xlValues, _
    Optional LookAtWholeOrPart As XlLookAt = xlPart, _
    Optional SearchRowCol As XlSearchOrder = xlByRows, _
    Optional SearchUpDn As XlSearchDirection = xlPrevious, _
    Optional bMatchCase As Boolean = False) As Range

    If StartingAfter Is Nothing Then
    Set StartingAfter = SearchRange.Cells(1)
    End If

    Set RangeFound = SearchRange.Find(What:=FindWhat, _
    After:=StartingAfter, _
    LookIn:=LookAtTextOrFormula, _
    LookAt:=LookAtWholeOrPart, _
    SearchOrder:=SearchRowCol, _
    SearchDirection:=SearchUpDn, _
    MatchCase:=bMatchCase)
    End Function[/VBA]

    By the way, where is Anguilla?

    Hope that helps,

    Mark

  3. #3
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    perhaps...

    [vba]
    Sub FindFirstNumericInString()
    Dim LR As Long, i As Long
    Dim strTest
    LR = Range("C" & Rows.Count).End(xlUp).Row
    For R = 1 To LR
    IndexI = IndexI + 1 'change the position of this line to your requirement
    If InStr(1, Cells(R, 4), "STATUS CODE") > 0 Then
    strTest = Split(Cells(R, 4), " ")
    For i = LBound(strTest) To UBound(strTest)
    If IsNumeric(strTest(i)) Then
    Sheet2.Cells(IndexI, 4).Value = strTest(i)
    Exit For
    End If
    Next i
    End If
    Next R
    End Sub
    [/vba]

    i assume you want to extract the first occurence of a number in the string.

    IndexI = IndexI + 1 counter makes the code write walues to corresponding rows in Sheet2. so if this is not the case, its place must be changed.
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  4. #4
    VBAX Contributor
    Joined
    Jun 2008
    Posts
    169
    Location
    Quote Originally Posted by mancubus
    perhaps...

    [vba]
    Sub FindFirstNumericInString()
    Dim LR As Long, i As Long
    Dim strTest
    LR = Range("C" & Rows.Count).End(xlUp).Row
    For R = 1 To LR
    IndexI = IndexI + 1 'change the position of this line to your requirement
    If InStr(1, Cells(R, 4), "STATUS CODE") > 0 Then
    strTest = Split(Cells(R, 4), " ")
    For i = LBound(strTest) To UBound(strTest)
    If IsNumeric(strTest(i)) Then
    Sheet2.Cells(IndexI, 4).Value = strTest(i)
    Exit For
    End If
    Next i
    End If
    Next R
    End Sub
    [/vba]

    i assume you want to extract the first occurence of a number in the string.

    IndexI = IndexI + 1 counter makes the code write walues to corresponding rows in Sheet2. so if this is not the case, its place must be changed.

    yeah ..... thxx its learn me much .thxx

  5. #5
    VBAX Guru mancubus's Avatar
    Joined
    Dec 2010
    Location
    "Where I lay my head is home" :D
    Posts
    2,644
    you are welcome...
    PLS DO NOT PM; OPEN A THREAD INSTEAD!!!

    1) Posting Code
    [CODE]PasteYourCodeHere[/CODE]
    (or paste your code, select it, click # button)

    2) Uploading File(s)
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) (multiple files can be selected while holding Ctrl key) / Upload Files / Done
    Replace company specific / sensitive / confidential data. Include so many rows and sheets etc in the uploaded workbook to enable the helpers visualize the data and table structure. Helpers do not need the entire workbook.

    3) Testing the Codes
    always back up your files before testing the codes.

    4) Marking the Thread as Solved
    from Thread Tools (on the top right corner, above the first message)

  6. #6
    Knowledge Base Approver VBAX Wizard
    Joined
    Apr 2012
    Posts
    5,645
    or ??
    [VBA]Sub M_snb()
    For each cl in columns(3).specialcells(2)
    If InStr(cl.offset(,1), "STATUS CODE") Then cl.offset(,1)=Val(split(cl.offset(,1),"Status code")(1))
    Next
    End Sub[/VBA]

  7. #7
    @GTO.
    Re: By the way, where is Anguilla?

    Part of the British Virgin Islands if I am not mistaken.

  8. #8
    Knowledge Base Approver VBAX Guru GTO's Avatar
    Joined
    Sep 2008
    Posts
    3,368
    Location
    Quote Originally Posted by jolivanes
    @GTO.
    Re: By the way, where is Anguilla?

    Part of the British Virgin Islands if I am not mistaken.
    Thank you :-)

    I had a moment to look it up. Extremely gorgeous beaches!

Posting Permissions

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