Copying parts of a line

barissh

Board Regular
Joined
Aug 10, 2006
Messages
94
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.
 

Excel Facts

Using Function Arguments with nested formulas
If writing INDEX in Func. Arguments, type MATCH(. Use the mouse to click inside MATCH in the formula bar. Dialog switches to MATCH.

jimboy

Well-known Member
Joined
Apr 11, 2002
Messages
2,314
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

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
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
Code:
'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

Board Regular
Joined
Aug 10, 2006
Messages
94
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

Well-known Member
Joined
Apr 11, 2002
Messages
2,314

ADVERTISEMENT

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

Code:
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

Board Regular
Joined
Aug 10, 2006
Messages
94
hi,

Thanks for your message.

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

barissh

Board Regular
Joined
Aug 10, 2006
Messages
94

ADVERTISEMENT

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

Well-known Member
Joined
Apr 11, 2002
Messages
2,314
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

Well-known Member
Joined
Aug 21, 2005
Messages
4,824
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

Board Regular
Joined
Aug 10, 2006
Messages
94
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.
 

Forum statistics

Threads
1,136,427
Messages
5,675,789
Members
419,586
Latest member
RoteichA

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top