| Expert 8TB |
Hello There,
I am trying to write a macro that will copy part of Text in a Cell & then paste in another cell.
For example,
assume cell A1="ABE_BC1 AbTS 11 bisTSport 2", I would like to copy/Paste "11" in cell A2 & 2 IN cell A3 .How do i achieve this with a macro instead?
Can anyone help?
CELL A1 = ADDRESS CELL B1 = BOARD CELL C1 = SLOT
CELL A2 = ABE_BC1 AbTS 11 bisTSport 2 CELL B2 = 11 CELL C2 = 12
CELL A3 = ABE_BC1 |AbTS 11 AbTSport 3 CELL B3 = 11 CELL C3 = 3
CELL A4 = ABE_BC1 |AbTS 11 AbTSport 3 CELL B4 = 11 CELL C4 = 3
CELL A5 = ABE_BC1 |AbTS 14 AbTSport 4 CELL B5 = 14 CELL C5 = 4
CELL A6 = UMH_BC1 |AbTS 2 AbTSport 5 CELL B6 = 2 CELL C6= 5
CELL A7 = UMH_BC1 |AbTS 2 AbTSport 5 CELL B7 = 2 CELL C7 = 5
Try this. - Sub DoIt()
-
Dim I As Long
-
For I = 2 To 7
-
Cells(I, 2).Value = Word(3, Cells(I, 1).Value)
-
Cells(I, 3).Value = Word(5, Cells(I, 1).Value)
-
Next
-
End Sub
-
-
-
Private Function Word(DesiredWord As Long, FromString As String) As String
-
Dim I As Long, J As Long, Char As String * 1
-
Dim WordNum As Long, StartPos As Long, NextSpace As Long
-
Dim WhatWasFound As String
-
StartPos = 1
-
If FromString = "" Then Exit Function
-
Do
-
WordNum = WordNum + 1
-
NextSpace = InStr(StartPos, FromString, " ")
-
If NextSpace = 0 Then
-
If WordNum = DesiredWord Then
-
WhatWasFound = Mid$(FromString, StartPos)
-
End If
-
Exit Do
-
End If
-
If WordNum = DesiredWord Then
-
WhatWasFound = Mid$(FromString, StartPos, NextSpace - StartPos)
-
Exit Do
-
End If
-
StartPos = NextSpace + 1
-
Loop
-
Word = Trim$(WhatWasFound)
-
End Function
-
I have made a lot of assumptions, of course. But I tried to make it flexible where possible. For one thing, the Word() function lets you specify that you want the 1st word, 2nd word or whatever, from the input string. This may not match what you want to do.
My results... Before - ADDRESS BOARD SLOT
-
ABE_BC1 AbTS 11 bisTSport 2
-
ABE_BC1 |AbTS 11 AbTSport 3
-
ABE_BC1 |AbTS 11 AbTSport 3
-
ABE_BC1 |AbTS 14 AbTSport 4
-
UMH_BC1 |AbTS 2 AbTSport 5
-
UMH_BC1 |AbTS 2 AbTSport 5
After - ADDRESS BOARD SLOT
-
ABE_BC1 AbTS 11 bisTSport 2 11 2
-
ABE_BC1 |AbTS 11 AbTSport 3 11 3
-
ABE_BC1 |AbTS 11 AbTSport 3 11 3
-
ABE_BC1 |AbTS 14 AbTSport 4 14 4
-
UMH_BC1 |AbTS 2 AbTSport 5 2 5
-
UMH_BC1 |AbTS 2 AbTSport 5 2 5
| |
