Substrings from String

**bdb1974** · 02-19-2010, 02:10 PM

Hi all,

I'm trying to break down a string and put parts into designated cells using the following
code. I'm not sure what's causing the problem, but the substring results are not correct.


Sub BOMINSERT_HEADERS()
Dim OutPL As Worksheet
Dim SText As String
  Sheets("BOM_INSERT").Activate
  SText = Cells(2, "B").Value

 Set OutPL = Sheets("BOM")
   OutPL.Cells(3, "C") = SText
  ' OutPL.Cells(6, "C") = SText
  ' OutPL.Cells(7, "C") = SText
  ' OutPL.Cells(8, "C") = SText
  ' OutPL.Cells(9, "C") = SText
 
 
 
  Sheets("BOM").Activate
 Cells(6, "C") = WorksheetFunction.Substitute(Cells(3, "C"), "\", "~", 3)
 Cells(6, "C") = Right(Cells(6, "C"), InStr(1, Cells(6, "C"), "~") - 1)
 'Cells(7, "C") = WorksheetFunction.Substitute(Cells(7, "C"), "\", "~", 3)
 Cells(9, "C") = Right(Cells(6, "C"), InStr(1, Cells(6, "C"), "\"))
 Cells(8, "C") = WorksheetFunction.Substitute(Cells(8, "C"), "\", "~", 3)
 Cells(8, "C").Value = Right(Cells(8, "C"), InStr(1, Cells(8, "C").Value, "~") - 1)
  'Cells(6, "C") = WorksheetFunction.Substitute(Cells(3, "C"), "\", "~", 3)
 Cells(6, "C") = Left(Cells(6, "C"), InStr(1, Cells(6, "C"), "\") - 1)
   'OutPL.Cells(9, "C").Value = OutPL.Cells(7, "C").Value
' Cells(9, "C") = WorksheetFunction.Substitute(Cells(9, "C"), "\", "~", 1)
 'Cells(9, "C").Value = Left(Cells(8, "C"), InStr(1, Cells(8, "C"), "\") - 1)
  'Cells(9, "C").Value = Right(Cells(9, "C"), InStr(1, Cells(9, "C"), "\") - 1)
End Sub

Attached also is an example booklet. I've given an example of a 2nd string possiblity
that I'd like to have broken down if possible.

Any help getting this working is appreciated.

Thanks

BDB

**JBeaucaire** · 02-19-2010, 04:05 PM

Based on your sheeet, the following worksheet formulas give you the results you want. ALL four formulas have to be there for the second one to work, it is dependent on formulas 1 and 3.

In C6: =IF(ISNUMBER(SEARCH("4WW", $C$3)), "4WW", IF(ISNUMBER(SEARCH("4PY", $C$3)), "4PY", "neither"))
In C7: =MID($C$3,SEARCH($C$6,$C$3)+LEN($C$6)+1,SEARCH($C$8,$C$3)-(SEARCH($C$6,$C$3)+LEN($C$6)+1))
In C8: =IF(ISNUMBER(SEARCH("UG Feeder", $C$3)), "UG Feeder", "UG")
In C9: =MID($C$3,SEARCH("|",SUBSTITUTE($C$3,"\","|",LEN($C$3)-LEN(SUBSTITUTE($C$3,"\",""))))+1,99)

Maybe that will help you design the macro.

**bdb1974** · 02-19-2010, 04:52 PM

Thanks JBeaucaire for your input. I'm just wondering how within the formuals ,I'm going to sub in a variant for the Search fields? I tried subsituting one of the slant bars,"\" in the string to a "~" as a reference point /marker. Then I was hoping to transfer only the section of the string that was on the side of the marker that I was needing for the designated cell. :/

**JBeaucaire** · 02-19-2010, 05:00 PM

I did that with the 4th formula, I just used the pipe character instead of tilde. Tilde has meaning in VBA such that I don't use it.

**JBeaucaire** · 02-19-2010, 05:04 PM

Simplest would be to put the formulas in the cells and leave them there. As soon as you enter a new value in C3, you have your values and can copy them elsewhere.

**Leith Ross** · 02-20-2010, 11:58 PM

Hello bdb1974,

Here is a macro to split up the string. Since string manipulation in VBA and Excel is limited to simple operations, this macro uses VB Script's Regular Expressions to perform pattern matching, string extraction, and replacement. I know this looks like gibberish, but is a very powerful and flexible way to manipulate strings. For anyone who is serious about programming or working web pages, this is a must have tool. This macro has been added to the attached workbook.

Sub ExtractStrings()

  Dim RegExp As Object
  Dim S As String
  Dim Z As String
  Dim Wks As Worksheet
  
    Set RegExp = CreateObject("VBScript.RegExp")
    RegExp.IgnoreCase = True
    
    Set Wks = Worksheets("BOM")
    S = Worksheets("BOM_INSERT").Range("B2")
    
     'Extract the file name
      RegExp.Pattern = "(.+)(\\.+\.\w{1,4})$"
      Z = RegExp.Replace(S, "$2")
      Wks.Range("C9") = Right(Z, Len(Z) - 1)
    
     'Reduce string to 3 digit code, location & description
      S = Left(S, Len(S) - Len(Z))
      RegExp.Pattern = "(.+\\)(.+)"
      S = RegExp.Replace(S, "$2")
    
     'Extract description - UG and the word following it
      RegExp.Pattern = "^(.*)(\sUG)(\s+\w+)?(.*)$"
      Wks.Range("C8") = LTrim(RegExp.Replace(S, "$2$3"))
      S = RegExp.Replace(S, "$1")
    
     'Extract the 3 digit code and location
      RegExp.Pattern = "(\w+)(\-)?(.+)"
      Wks.Range("C6") = RegExp.Replace(S, "$1")
      Wks.Range("C7") = LTrim(RegExp.Replace(S, "$3"))
    
    Set RegExp = Nothing
    
End Sub

**bdb1974** · 02-23-2010, 05:08 PM

Thanks Leith,

Here's another method that I finally came up with and used after playing around with some code.

Sub BOMINSERT_HEADERS()
  Dim OutPL As Worksheet
  Dim Startrow As Variant
  Dim SText As String


 ' ThisWorkbook.Activate
'   **********************************

  

  Application.ScreenUpdating = False

    Sheets("BOM_INSERT").Activate
  UnProtectShts
  SText = Cells(2, "B").Value

 Set OutPL = Sheets("BOM")
   OutPL.Cells(6, "C") = SText
    OutPL.Cells(7, "C") = SText
 OutPL.Cells(18, "C").Value = SText
 
 OutPL.Cells(4, "C") = SText
 
 
  Sheets("BOM").Activate
  
  'The following 3 lines are not reliable.  In Excel VBA, using WorksheetFunction spaces, "" gets confused with the backwards slash bar, "\".
'  Cells(4, "C") = Right(Cells(4, "C"), (Len(Cells(4, "C")) - WorksheetFunction.Find("\", Cells(4, "C"), 1)))
'Cells(4, "C") = Right(Cells(4, "C"), (Len(Cells(4, "C")) - WorksheetFunction.Find("\", Cells(4, "C"), 1)))
'Cells(4, "C") = Left(Cells(4, "C"), (Len(Cells(4, "C")) - WorksheetFunction.Find("\", Cells(4, "C"), 1)))


 Cells(18, "C") = WorksheetFunction.Substitute(Cells(18, "C"), "\", "|", 4)
 Cells(18, "C") = Left(Cells(18, "C"), InStr(1, Cells(18, "C"), "|"))
    If InStr(1, Cells(18, "C").Value, "|") > 0 Then
        arr = Split(Cells(18, "C").Value, "|")
        Cells(18, "C").Value = arr(0)
        End If
        
  Cells(6, "C") = WorksheetFunction.Substitute(Cells(6, "C"), "\", "|", 3)
       If InStr(1, Cells(6, "C").Value, "|") > 0 Then
        arr = Split(Cells(6, "C").Value, "|")
        Cells(8, "C").Value = arr(1)
        End If
   Cells(7, "C") = WorksheetFunction.Substitute(Cells(7, "C"), "\", "|", 3)
   
 'Cells(6, "C") = Right(Cells(6, "C"), InStr(1, Cells(6, "C"), "|") - 1)
  Cells(7, "C") = WorksheetFunction.Substitute(Cells(7, "C"), "\", "|", 4)
     'Cells(8, "C").Value =
       If InStr(1, Cells(7, "C").Value, "|") > 0 Then
        arr = Split(Cells(7, "C").Value, "|")
        Cells(7, "C").Value = arr(1)
        End If
     Cells(8, "C") = WorksheetFunction.Substitute(Cells(7, "C"), "\", "|", 2)
      If InStr(1, Cells(8, "C").Value, "|") > 0 Then
        arr = Split(Cells(8, "C").Value, "|")
        Cells(8, "C").Value = arr(1)
        End If
        
      Cells(8, "C") = WorksheetFunction.Substitute(Cells(7, "C"), "\", "|", 1)
      If InStr(1, Cells(8, "C").Value, "|") > 0 Then
        arr = Split(Cells(8, "C").Value, "|")
        Cells(9, "C").Value = arr(1)
        End If
        
      Cells(7, "C") = WorksheetFunction.Substitute(Cells(7, "C"), "\", "|", 1)
     'Cells(8, "C").Value =
       If InStr(1, Cells(7, "C").Value, "|") > 0 Then
        arr = Split(Cells(7, "C").Value, "|")
        Cells(7, "C").Value = arr(0)
        End If
        
           Cells(8, "C") = WorksheetFunction.Substitute(Cells(7, "C"), "\", "|", 1)
     'Cells(8, "C").Value =
       If InStr(1, Cells(7, "C").Value, "|") > 0 Then
        arr = Split(Cells(7, "C").Value, "|")
        Cells(8, "C").Value = arr(1)
        End If
        
        
          Cells(6, "C") = WorksheetFunction.Substitute(Cells(7, "C"), " ", "|", 1)
       If InStr(1, Cells(6, "C").Value, "|") > 0 Then
        arr = Split(Cells(6, "C").Value, "|")
        Cells(6, "C").Value = arr(0)
        End If
        
        If InStr(1, Cells(8, "C").Value, "-") > 0 Then
        Cells(8, "C") = (WorksheetFunction.Substitute(Cells(8, "C"), "-", "|", 1))
        arr = Split(Cells(8, "C").Value, "|")
        Cells(8, "C").Value = arr(1)
        Cells(8, "C") = Right(Cells(8, "C"), (Len(Cells(8, "C")) - WorksheetFunction.Find(" ", Cells(8, "C"), 1)))
        If InStr(1, Cells(8, "C").Value, " ") > 0 Then
        Cells(8, "C") = Left(Cells(8, "C"), (Len(Cells(8, "C")) - WorksheetFunction.Find(" ", Cells(8, "C"), 1)))
        End If
        Else
        Cells(8, "C").Value = ""
        End If
        
     If InStr(1, Cells(7, "C").Value, " ") > 0 Then
       Cells(7, "C") = (WorksheetFunction.Substitute(Cells(7, "C"), " ", "|", 1))
        arr = Split(Cells(7, "C").Value, "|")
      Cells(7, "C").Value = arr(1)
        End If
             If InStr(1, Cells(7, "C").Value, "-") > 0 Then
       Cells(7, "C") = (WorksheetFunction.Substitute(Cells(7, "C"), "-", "|", 1))
        arr = Split(Cells(7, "C").Value, "|")
      Cells(7, "C").Value = arr(0)
        End If
        



End If
End With
With ThisWorkbook.Sheets("BOM")
Cells(1, 1).Select
End With



Set FSO = Nothing
Set fs = Nothing

End Sub

Thanks for everyone's help.

BDB