Remove extra words in string based on the words in the string

[peterrudge]

I regularly import CSV file data into an excel template. One of the columns in the template contains a material name. The material values are in the following format:

"3/4 Int White Oak/Maple Mel"
"3/4 Ext White Oak/Maple Mel"
"Door/Drawer White Oak/Maple Mel"

I want to reword them as:

[TABLE="width: 1000, align: center"]
<tbody>[TR]
[TD]"3/4 Maple Mel"[/TD]
[TD]If second word is "Int" return the first word, and the everything right of "/"[/TD]
[/TR]
[TR]
[TD]"3/4 White Oak"[/TD]
[TD]If second word is "Ext" return the first word, and the everything left of "/" to the second space in the string[/TD]
[/TR]
[TR]
[TD]"Door/Drawer White Oak/Maple Mel"[/TD]
[TD]If second word isn't "Int" or "Ext" dont chage the text[/TD]
[/TR]
</tbody>[/TABLE]


I currently get this done with a helper column and a long formula.

I would like to have this done as part of the import process with VBA so I don't need a helper column and the value in the cell is text not a formula.

Here is a link to a sample workbook. https://skydrive.live.com/redir?page=view&resid=8EB78428BD73FB8!4102&authkey=!AFvtx0k2BWtD8-w

The helper column is "K" the original material values are in "F"

I have no experience with VBA but the code I have put together from Googling is below (I haven't gotten it to run yet). To use this code I would have to change the material text to this format:

"3/4-Int-White Oak-Maple Mel"

Dim KCDMat() As Variant
        
    Dim Cell As Range
    With ActiveSheet
        For Each Cell In Intersect(.Range("F:F"), .UsedRange)
            'Split up the words in the text string
        KCDMat() = Split(Cell.Value, "-")
        
        'check to see if interior material
        If KCDMat(1) = "Int" Then
            'substitute interior material for "Int"
            Cell.Value = KCDMat(0, 3)
            
        'check to see if exterior material
        ElseIf KCDMat(1) = "Ext" Then
            'substitute exterior material for "Ext"
            Cell.Value = KCDMat(0, 2)
            
        Else
        
        End If
        
        Next
    
    End With

Any ideas on VBA to parse the text ideally as part of the import process?

 

[Rick Rothstein]

Give this macro a try...

Sub IntExt()
  Dim X As Long, vArr As Variant, Parts() As String
  vArr = Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).Row)
  For X = 1 To UBound(vArr)
    Parts = Split(vArr(X, 1) & "  ", " ", 3)
    Select Case Parts(1)
      Case "Int"
        vArr(X, 1) = Trim(Parts(0) & " " & Mid(Parts(2), InStr(Parts(2), "/") + 1))
      Case "Ext"
        vArr(X, 1) = Trim(Parts(0) & " " & Split(Parts(2) & "/", "/", 2)(0))
    End Select
  Next
  Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).Row) = vArr
End Sub

 

[peterrudge]

I spent more time working on my first attempt at VBA. I changed the format of the CSV file input string to:

[TABLE="class: cms_table, width: 1000, align: center"]
<tbody>[TR]
[TD]"3/4-Int-White Oak-Maple Mel"[/TD]
[TD]Now using a "-" to delineate different workds.[/TD]
[/TR]
</tbody>[/TABLE]

Dim lR As Long
lR = Range("F" & Rows.Count).End(xlUp).Row


    
   
    Dim KCDMat() As String
    Dim IntOrExt As String
    Dim IntMat As String
    Dim ExtMat As String
    Dim Thickness As String
    Dim i As Integer
    i = 2


    Do While i < lR + 1
    
   
    
                Material = Cells(i, 6).Value
                
                'Split up the words in the text string
                KCDMat = Split(Material, "-")
                Thickness = Trim(KCDMat(0))
                
                If Application.CountA(KCDMat) > 3 Then
                    IntMat = Trim(KCDMat(3))
                    ExtMat = Trim(KCDMat(2))
                    IntOrExt = Trim(KCDMat(1))
                    
                Else
                
                End If
                
                
                
                
                'check to see if interior material
                If IntOrExt = "Int" Then
                'substitute interior material for "Int"
                Cells(i, 6) = Thickness & " " & IntMat
                
            
                'check to see if exterior material
                ElseIf IntOrExt = "Ext" Then
                'substitute exterior material for "Ext"
                Cells(i, 6) = Thickness & " " & ExtMat
                
        Else
               
            End If
            
        i = i + 1
    Loop

 

[Rick Rothstein]

I spent more time working on my first attempt at VBA. I changed the format of the CSV file input string to:

[TABLE="class: cms_table, width: 1000, align: center"]
<tbody>[TR]
[TD]"3/4-Int-White Oak-Maple Mel"[/TD]
[TD]Now using a "-" to delineate different workds.[/TD]
[/TR]
</tbody>[/TABLE]

Just wondering if your saw the macro I posted in Message #2 (which works on your originally posted text without the need to insert the dashes you are now showing)?

 

[peterrudge]

Awesome Rick! Your code inspires me to stick with learning VBA so I can create concise code like yours.

I tried running the code you provided and ran into an unexpected condition. The values in the csv file I import sometimes includes a leading space character before " 3/4 Int White Oak/Maple Mel" . This causes the code to skip over those. Where would I insert a trim so the extra spaces would be removed before parsing the text?

 

[Rick Rothstein]

Awesome Rick! Your code inspires me to stick with learning VBA so I can create concise code like yours.

I tried running the code you provided and ran into an unexpected condition. The values in the csv file I import sometimes includes a leading space character before " 3/4 Int White Oak/Maple Mel" . This causes the code to skip over those. Where would I insert a trim so the extra spaces would be removed before parsing the text?

Untested, but I think the change in red should solve your problem...

Sub IntExt()
  Dim X As Long, vArr As Variant, Parts() As String
  vArr = Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).Row)
  For X = 1 To UBound(vArr)
    Parts = Split(Trim(vArr(X, 1)) & "  ", " ", 3)
    Select Case Parts(1)
      Case "Int"
        vArr(X, 1) = Trim(Parts(0) & " " & Mid(Parts(2), InStr(Parts(2), "/") + 1))
      Case "Ext"
        vArr(X, 1) = Trim(Parts(0) & " " & Split(Parts(2) & "/", "/", 2)(0))
    End Select
  Next
  Range("F1:F" & Cells(Rows.Count, "F").End(xlUp).Row) = vArr
End Sub

 

[peterrudge]

Rick, thank you! Your code works great.