Copying parts of a line

[barissh]

Hi guys,

I need a macro which copies a part of info from a line in sheet1 and pastes it to Sheet2.

XXXX1234567 - Routing: [CNQND CNQND ITTRA - TRKUM TRKUM] Carrier: HML


1) I need to insert a control at 44 and 45th digits. If here, 2 digits start with TR then it will copy it with next 3 digits (TRKUM) and paste to Sheet2 B1. If not, it will check same control at 50 and 51th digits. If again, it can not find TR then it will disregard step 2&3 and go to item 4.

2) Copy first 11 digits(XXXX1234567) and paste it to Sheet2 A1

3) It will find the wording "Carrier:" and it will copy next 3 digits (HML) and copy to Sheet2 C1

4) It will go 3 lines down (A1,A4,A7...) and starts to same action again till the end of the list at A column.

 

[jindon]

try

Sub test()
Dim r As Range, Rex As Object
Set Rex = CreateObject("VBScript.RegExp")
With Sheets("Sheet1")
   For Each r In .Range("a1",.Range("a" & Rows.Count).End(xlUp))
      Rex.Pattern = "(TR)\S+"
      Sheets("Sheett2").Range(r.Address).Resize(,2).Value = _
            Array(Left(r.Value,11),Rex.execute(r.Value)(0))
   Next
End With
Set Rex = Nothing
End Sub

 

[barissh]

      Sheets("Sheett2").Range(r.Address).Resize(,2).Value = _
            Array(Left(r.Value,11),Rex.execute(r.Value)(0))

Thnx but macro has given type mismatch error at quoted lines.

 

[jindon]

Hummm
How about

Sub sample()
Dim r As Range, Rex As Object
Set Rex = CreateObject("VBScript.RegExp")
With Sheets("Sheet1")
   For Each r In .Range("a1",.Range("a" & Rows.Count).End(xlUp))
      Rex.Pattern = "(TR)\S+"
      Sheets("Sheett2").Range(r.Address).Value = Left(r.Value,11)
      With Rex
         .Pattern = "(TR)\S+"
         If .test(r.Value) Then
            Sheets("Sheet2").Range("r.Address).Offset(,1).Value = .execute(r.Value)(0)
         End If
      End With
   Next
End With
Set Rex = Nothing
End Sub

 

[barissh]

syntax error at "Sub sample ()" line.

 

[jindon]

You need to replace the new code with the old one.

You can not have same sub name.