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.

 

[jimboy]

Hi - the 44th digit is a space, do you want the 45th and 46th digits?

The first letter after Carrier is a space, do you want the 3 digits after the space?

When the code is applied to A4, A7 etc what row in sheet 2 should I use?

 

[venkat1926]

There are some ambiguities in your requirement which I have quoted below
quote
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.
Unquote


If TR is not found in 44/45th digit but found in 50/51t digit what should be done? I presume that steps 2 and 3 are to be done.

I presume any value calculated on the basis of conditions should be copied in the corresponding row in sheet2. Under this presumption macro “test” is to be run

If it is to be copied one by one in sheet2 without gaps then slight modification is to be done. In addition to running “test” you should also run the macro “removeblankrows”.
.

As it is highly tailored keep your sheet somewhere safe before running the macros. inform if there are any bugs

Venkat

The macros are

'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.

Dim j, k, m, n As Integer
Dim c As Range
Dim x
Option Explicit
Sub test()
Worksheets("sheet2").Activate
ActiveSheet.Cells.Clear
Worksheets("sheet1").Activate
j = ActiveSheet.UsedRange.Rows.Count
'msgbox j
For k = 1 To j

'MsgBox k
Set c = Cells(k, 1)
'msgbox c.Address
'msgbox c
'msgbox Mid(c, 44, 2)
If Mid(c, 45, 2) = "TR" Then
x = Mid(c.Value, 45, 5)
'msgbox x
Worksheets("sheet2").Cells(k, "b") = x
ElseIf Mid(c.Value, 51, 2) = "TR" Then
'step 2
x = Left(c.Value, 11)
Worksheets("sheet2").Cells(k, "a") = x
'step 3
m = InStr(1, c.Value, "carrier:", 1)
If m <> 0 Then
x = Mid(c.Value, m, 11)
Worksheets("sheet2").Cells(k, "c") = x
End If
Else
k = k + 2
End If
Next
Worksheets("sheet2").Activate
MsgBox "test over"
End Sub

Sub removeblankrows()

j = Cells(Rows.Count, "a").End(xlUp).Row
'MsgBox j
k = Cells(Rows.Count, "b").End(xlUp).Row
'MsgBox k
m = Cells(Rows.Count, "c").End(xlUp).Row
'MsgBox m
n = WorksheetFunction.Max(j, k, m)
'MsgBox n
For k = n To 1 Step -1
If Cells(k, "a") = "" And Cells(k, "b") = "" And Cells(k, "c") = "" Then
'MsgBox Cells(k, "a").Row
Cells(k, "a").EntireRow.Delete
End If
Next
MsgBox "blank rows removed"
End Sub

 

[barissh]

hi,

-yes you re right. I mean 45 and 46th and also other control at 51 and 52nd digits.

-Yes 3 digits after space

-When each row complited it will copy them to lower row of Sheet2
a1 XXXX1234567 b1 TRKUM c1 HML
a2 YYYY1234567 b2 TRXXX c2 XXX
a3 ZZZZ1234567 b3 TRYYY c3 YYY

 

[jimboy]

This works for me, but you only posted one example....

Sub test()

Dim mytext As String
Dim c As Range
Dim i
Dim myrow As Long

myrow = 1

For i = 1 To Range("A65536").End(xlUp).Row Step 3
mytext = Cells(i, 1).Text
If Mid(mytext, 45, 2) = "TR" Then
Sheets("Sheet2").Cells(myrow, 2) = Mid(mytext, 45, 5)
Sheets("Sheet2").Cells(myrow, 1) = Mid(mytext, 1, 11)
Sheets("Sheet2").Cells(myrow, 3) = Mid(mytext, Application.WorksheetFunction.Find("Carrier:", mytext, 1) + 9, 3)
myrow = myrow + 1
GoTo myskip
End If

If Mid(mytext, 50, 2) = "TR" Then
Sheets("Sheet2").Cells(myrow, 2) = Mid(mytext, 50, 5)
Sheets("Sheet2").Cells(myrow, 1) = Mid(mytext, 1, 11)
Sheets("Sheet2").Cells(myrow, 3) = Mid(mytext, Application.WorksheetFunction.Find("Carrier:", mytext, 1) + 9, 3)
myrow = myrow + 1
End If

myskip:
Next i
End Sub

 

[barissh]

hi,

Thanks for your message.

Macro gave type mismatch error at
***If Mid(c, 45, 2) = "TR" Then*** line.

 

[barissh]

Thnx Jimboy, your macro works but there are still some problems

If there is not TR at A1, program does not control other lines even
there are some records which starts with TR after A1.

If there exist TR at A1 macro is working till it can not find TR but
actually I want macro controls all the lines till the end.

 

[jimboy]

Hi - I don't understand.

The macro starts at cell A1 and look at the 45th/46th digits, if they equal "TR" then it copied them (plus the next 3 digits) to Sheet2, column 2 (and the first 11 digits to column A and the first 3 digits after Carrier: to column 3)

If those digits don't equal "TR" then it checks the 50th/51st digits and does the same.

If neither of those are true then it skips three cells down (i.e. to A4) and so on.

 

[venkat1926]

quote
Thanks for your message.

Macro gave type mismatch error at
***If Mid(c, 45, 2) = "TR" Then*** lin
unquote

change it to :
if mid(c.value,45,2) then .........

venkat

 

[barissh]

Hi Jimboy,

FCIU1234561 - Routing: [SEHSB DEHBG ITTRA - GRPIR GRPIR] Carrier: HML
#NAME?

FCIU1234562 - Routing: [IDJAB IDJAB ITTRA - TRGMK TRGMK] Carrier: EGL
#NAME?

FCIU1234563 - Routing: [CNYYT CNYYT ITTRA - TRHYJ TRHYJ] Carrier: HML
#NAME?

FCIU1234564 - Routing: [AUMEL AUMEL ITTRA - TRGMK TRGMK] Carrier: LLT
#NAME?

FCIU1234565 - Routing: [CNXTH CNXTH ITTRA - GRTKI GRTKI] Carrier: EGL
#NAME?

FCIU1234566 - Routing: [CNNHT CNSHG ITTRA - GRPIR GRPIR] Carrier: HML
#NAME?

TCNU1234567 - Routing: [FIHEL FIHEL ITTRA - TRGMK TRGMK] Carrier: LLT
#NAME?

This is a part from my list. You can use your macro on this example.

-When 45-46th and 51-52nd digits in A1 line are not starting with TR, macro is not working.
-When 45-46th and 51-52nd digits in A1 line are starting with TR, macro is
working till final part which start with TCNU1234567.....But since mentioned digits include "TR",macro has to work on this line too.

Pls firstly do not change this example and try your macro then change 45-46th and 51-52nd digits in A1 line as "TR" and try again.

Thanks in advance.