Manipulate a String

[stuartgb100]

Hi,
I have text data in column A.
Case 1: the data consists of a word or phrase in English, followed by the French translation.
The value ':' separates the English and French.
How can I use VBA to place the values after the ':' into col B, and remove from col A ?

Case 2: data in col A is the same as Case 1, but his time the first characters after the ':' could be as follows: 'le' or 'la' or 'l'' - the last is l(apostrophe).
This time I need to do the same as Case 1, but also remove the 'le' or 'la' or 'l(apostrophe) and put that into col C.

For example:
[TABLE="width: 192"]
<colgroup><col width="64" style="width:48pt" span="3"> </colgroup><tbody>[TR]
[TD="width: 192, bgcolor: transparent, colspan: 3"]Glass door: la porte vitré
should change to:
[/TD]
[/TR]
</tbody>[/TABLE]
[TABLE="width: 192"]
<colgroup><col width="64" style="width:48pt" span="3"> </colgroup><tbody>[TR]
[TD="width: 192, bgcolor: transparent, colspan: 3"]Glass door porte vitré la

Many thanks.
[/TD]
[/TR]
</tbody>[/TABLE]

 

[footoo]

Sub Case1()
Dim rng As Range
Set rng = Range([B1], Cells(Rows.Count, "A").End(xlUp)(1, 2))
rng.Formula = "=LEFT(A1,FIND("":"",A1)-1)"
rng.Offset(, 1).Formula = "=RIGHT(A1,LEN(A1)-FIND("":"",A1)-1)"
rng.Resize(, 2) = rng.Resize(, 2).Value
[A:A].Delete
End Sub


Sub Case2()
Dim rng As Range
Set rng = Range([B1], Cells(Rows.Count, "A").End(xlUp)(1, 2))
rng.Formula = "=LEFT(A1,FIND("":"",A1)-1)"
rng.Offset(, 1).Formula = "=RIGHT(A1,LEN(A1)-FIND("":"",A1)-4)"
rng.Offset(, 2).Formula = "=LEFT(RIGHT(A1,LEN(A1)-FIND("":"",A1)-1),2)"
rng.Resize(, 3) = rng.Resize(, 3).Value
[A:A].Delete
End Sub

 

[Rick Rothstein]

Here are two other macros that should also do what you want...

[table="width: 500"]
[tr]
	[td]Sub Case1()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("A1:A" & LastRow).TextToColumns , xlDelimited, , , False, False, False, False, True, ":"
  Range("B1:B" & LastRow).Value = Evaluate("IF({1},TRIM(B1:B" & LastRow & "))")
End Sub

Sub Case2()
  Dim LastRow As Long
  LastRow = Cells(Rows.Count, "A").End(xlUp).Row
  Range("A1:A" & LastRow).TextToColumns , xlDelimited, , , False, False, False, False, True, ":"
  Range("B1:B" & LastRow).Value = Evaluate("IF({1},TRIM(B1:B" & LastRow & "))")
  Range("C1:C" & LastRow).Value = Evaluate("IF({1},LEFT(B1:B" & LastRow & ",2))")
  Range("B1:B" & LastRow).Value = Evaluate("IF({1},TRIM(MID(B1:B" & LastRow & ",3,99)))")
End Sub[/td]
[/tr]
[/table]

 

[nemmi69]

How about this?

Option Explicit


Dim LastRowNo As Long
Dim ChkArray As Variant
Dim LBChkAry As Integer
Dim UBChkAry As Integer
Dim Rloop As Long
Dim Chkloop As Long
Dim ColA As String
Dim ColB As String
Dim ColC As String
Dim IColonNum As Integer
Dim InNum As Integer
Dim InFnd As Boolean
Dim Tstring As String
' have text data in column A.
'Case 1: the data consists of a word or phrase in English, followed by the French translation.
'The Value ':' separates the English and French.
'How can I use VBA to place the values after the ':' into col B, and remove from col A ?
'
'Case 2: data in col A is the same as Case 1, but his time the first characters after the ':' could be as follows: 'le' or 'la' or 'l'' - the last is l(apostrophe).
'This time I need to do the same as Case 1, but also remove the 'le' or 'la' or 'l(apostrophe) and put that into col C.


Sub FindLastColRow()
LastRowNo = Worksheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).Row
If LastRowNo >= 1 Then
    ChkArray = Array("la", "La", "le", "Le", "l'", "L'")
    LBChkAry = LBound(ChkArray)
    UBChkAry = UBound(ChkArray)
    
    For Rloop = 1 To LastRowNo
        Tstring = ActiveSheet.Range("A" & Rloop).Value
        IColonNum = InStr(1, Tstring, ":")
        If IColonNum > 0 Then
            ColA = Left(Tstring, IColonNum - 1)
            Tstring = Trim(Right(Tstring, Len(Tstring) - IColonNum))
            InFnd = False
            For Chkloop = LBChkAry To UBChkAry
                InNum = Len(ChkArray(Chkloop))
                If Left(Tstring, InNum) = ChkArray(Chkloop) Then
                    InFnd = True
                    Exit For
                End If
            Next Chkloop
            If InFnd = True Then
                ColC = Trim(Left(Tstring, InNum))
                ColB = Trim(Right(Tstring, Len(Tstring) - InNum))
            Else
                ColC = ""
                ColB = Tstring
            End If
            ActiveSheet.Range("A" & Rloop).Value = ColA
            ActiveSheet.Range("B" & Rloop).Value = ColB
            ActiveSheet.Range("C" & Rloop).Value = ColC
        End If
    Next Rloop
End If
End Sub

 

[stuartgb100]

Many thanks for all the help.

I'll work though the approaches to try to understand what is happening.

Regards and thanks again.
Stuart.