lienlee

07-21-2010, 05:35 AM

How would i go about searching A column and looking through all its cell(or specific ones) grabs the first 5 number/alpha in that cell and copy/paste onto another worksheet? (not another excel spreadsheet)

View Full Version : Solved: Excel VBA

lienlee

07-21-2010, 05:35 AM

How would i go about searching A column and looking through all its cell(or specific ones) grabs the first 5 number/alpha in that cell and copy/paste onto another worksheet? (not another excel spreadsheet)

EDGE

07-21-2010, 06:21 AM

You can do something like this:

Sub MyTest()

Dim ws As Worksheet

Dim xRow As Integer

Set ws = ThisWorkbook.Sheets("Sheet3")

Set ws2 = ThisWorkbook.Sheets("Sheet4")

ws.Activate

xRow = 2

Do While ws.Cells(xRow, 1).Value <> "" ' Or some specific value you are expecting to find

' put some if logic here to compare the value

If ws.Cells(xRow, 1).Value = "Test1 is what you want" Then

ws2.Activate

ws2.Cells(xRow, 1).Value = Left(ws.Cells(xRow, 1).Value, 5)

End If

xRow = xRow + 1

ws.Activate

Loop

Set ws = Nothing

Set ws2 = Nothing

End Sub

Sub MyTest()

Dim ws As Worksheet

Dim xRow As Integer

Set ws = ThisWorkbook.Sheets("Sheet3")

Set ws2 = ThisWorkbook.Sheets("Sheet4")

ws.Activate

xRow = 2

Do While ws.Cells(xRow, 1).Value <> "" ' Or some specific value you are expecting to find

' put some if logic here to compare the value

If ws.Cells(xRow, 1).Value = "Test1 is what you want" Then

ws2.Activate

ws2.Cells(xRow, 1).Value = Left(ws.Cells(xRow, 1).Value, 5)

End If

xRow = xRow + 1

ws.Activate

Loop

Set ws = Nothing

Set ws2 = Nothing

End Sub

Aflatoon

07-21-2010, 06:35 AM

If you just want the left 5 regardless of content:

Sub CopyLeft5()

Dim sht1 As Worksheet, sht2 As Worksheet

Dim lStartRow As Long, lLastRow As Long

Set sht1 = ActiveSheet

Set sht2 = Sheets("Sheet2")

lLastRow = sht1.Cells(Rows.Count, "A").End(xlUp).Row

lStartRow = 1

sht2.Cells(1, 1).Resize(lLastRow - lStartRow + 1).Value = _

sht1.Evaluate("INDEX(LEFT(A" & lStartRow & ":A" & lLastRow & ",5),,1)")

End Sub

Sub CopyLeft5()

Dim sht1 As Worksheet, sht2 As Worksheet

Dim lStartRow As Long, lLastRow As Long

Set sht1 = ActiveSheet

Set sht2 = Sheets("Sheet2")

lLastRow = sht1.Cells(Rows.Count, "A").End(xlUp).Row

lStartRow = 1

sht2.Cells(1, 1).Resize(lLastRow - lStartRow + 1).Value = _

sht1.Evaluate("INDEX(LEFT(A" & lStartRow & ":A" & lLastRow & ",5),,1)")

End Sub

lienlee

07-21-2010, 08:05 AM

Thanks guys.

In addition, what would i put if i want the entire field? or up to a certain point like when it hits "."

and also while doing getting the the entire field.I want to be able to grab it and put "IA" infront of it.

for example

\009 Store Orders - Order Director\

I want to get rid of the \ and put IA

and if there is already IA ignore it.

so the end result will be IA009

In addition, what would i put if i want the entire field? or up to a certain point like when it hits "."

and also while doing getting the the entire field.I want to be able to grab it and put "IA" infront of it.

for example

\009 Store Orders - Order Director\

I want to get rid of the \ and put IA

and if there is already IA ignore it.

so the end result will be IA009

lienlee

07-21-2010, 11:50 AM

Thanks guys.

In addition, what would i put if i want the entire field? or up to a certain point like when it hits "."

and also while doing getting the the entire field.I want to be able to grab it and put "IA" infront of it.

for example

\009 Store Orders - Order Director\

I want to get rid of the \ and put IA

and if there is already IA ignore it.

so the end result will be IA009

edit:

In addition, what would i put if i want the entire field? or up to a certain point like when it hits "."

and also while doing getting the the entire field.I want to be able to grab it and put "IA" infront of it.

for example

\009 Store Orders - Order Director\

I want to get rid of the \ and put IA

and if there is already IA ignore it.

so the end result will be IA009

edit:

EDGE

07-21-2010, 12:00 PM

To get the entire field just modify the = to

ws2.Cells(xRow, 1).Value = ws.Cells(xRow, 1).Value

Take a look at the two different Do While statments and you will see how to achieve the results you are looking for.

Sub MyTest()

Dim ws As Worksheet

Dim xRow As Integer

Set ws = ThisWorkbook.Sheets("Sheet3")

Set ws2 = ThisWorkbook.Sheets("Sheet4")

ws.Activate

xRow = 2

' Only update Sheet4 when critera is met in Sheet3

Do While ws.Cells(xRow, 1).Value <> "" '

If ws.Cells(xRow, 1).Value = "Test1 is what you want" Then

ws2.Cells(xRow, 1).Value = "IA" & Left(ws.Cells(xRow, 1).Value, 5)

End If

xRow = xRow + 1

Loop

xRow = 2

' Update Sheet4 for every record found in Sheet3

Do While ws.Cells(xRow, 1).Value <> ""

ws2.Cells(xRow, 2).Value = "IA" & Left(ws.Cells(xRow, 1).Value, 5)

xRow = xRow + 1

Loop

Set ws = Nothing

Set ws2 = Nothing

ws2.Cells(xRow, 1).Value = ws.Cells(xRow, 1).Value

Take a look at the two different Do While statments and you will see how to achieve the results you are looking for.

Sub MyTest()

Dim ws As Worksheet

Dim xRow As Integer

Set ws = ThisWorkbook.Sheets("Sheet3")

Set ws2 = ThisWorkbook.Sheets("Sheet4")

ws.Activate

xRow = 2

' Only update Sheet4 when critera is met in Sheet3

Do While ws.Cells(xRow, 1).Value <> "" '

If ws.Cells(xRow, 1).Value = "Test1 is what you want" Then

ws2.Cells(xRow, 1).Value = "IA" & Left(ws.Cells(xRow, 1).Value, 5)

End If

xRow = xRow + 1

Loop

xRow = 2

' Update Sheet4 for every record found in Sheet3

Do While ws.Cells(xRow, 1).Value <> ""

ws2.Cells(xRow, 2).Value = "IA" & Left(ws.Cells(xRow, 1).Value, 5)

xRow = xRow + 1

Loop

Set ws = Nothing

Set ws2 = Nothing

lienlee

07-21-2010, 12:13 PM

To get the entire field just modify the = to

ws2.Cells(xRow, 1).Value = ws.Cells(xRow, 1).Value

Take a look at the two different Do While statments and you will see how to achieve the results you are looking for.

Sub MyTest()

Dim ws As Worksheet

Dim xRow As Integer

Set ws = ThisWorkbook.Sheets("Sheet3")

Set ws2 = ThisWorkbook.Sheets("Sheet4")

ws.Activate

xRow = 2

' Only update Sheet4 when critera is met in Sheet3

Do While ws.Cells(xRow, 1).Value <> "" '

If ws.Cells(xRow, 1).Value = "Test1 is what you want" Then

ws2.Cells(xRow, 1).Value = "IA" & Left(ws.Cells(xRow, 1).Value, 5)

End If

xRow = xRow + 1

Loop

xRow = 2

' Update Sheet4 for every record found in Sheet3

Do While ws.Cells(xRow, 1).Value <> ""

ws2.Cells(xRow, 2).Value = "IA" & Left(ws.Cells(xRow, 1).Value, 5)

xRow = xRow + 1

Loop

Set ws = Nothing

Set ws2 = Nothing

Hey thanks for your reply. Im confused which code shows what column its being used.

ws2.Cells(xRow, 1).Value = ws.Cells(xRow, 1).Value

Take a look at the two different Do While statments and you will see how to achieve the results you are looking for.

Sub MyTest()

Dim ws As Worksheet

Dim xRow As Integer

Set ws = ThisWorkbook.Sheets("Sheet3")

Set ws2 = ThisWorkbook.Sheets("Sheet4")

ws.Activate

xRow = 2

' Only update Sheet4 when critera is met in Sheet3

Do While ws.Cells(xRow, 1).Value <> "" '

If ws.Cells(xRow, 1).Value = "Test1 is what you want" Then

ws2.Cells(xRow, 1).Value = "IA" & Left(ws.Cells(xRow, 1).Value, 5)

End If

xRow = xRow + 1

Loop

xRow = 2

' Update Sheet4 for every record found in Sheet3

Do While ws.Cells(xRow, 1).Value <> ""

ws2.Cells(xRow, 2).Value = "IA" & Left(ws.Cells(xRow, 1).Value, 5)

xRow = xRow + 1

Loop

Set ws = Nothing

Set ws2 = Nothing

Hey thanks for your reply. Im confused which code shows what column its being used.

EDGE

07-21-2010, 12:18 PM

When using Cells the syntax is as follows Cells(Row, Column). So in the first Do While we are updating Column A (xRow, 1) 1 = A and in the Second we are updating Column B (xRow, 2) 2 = B.

This make more sense?

This make more sense?

EDGE

07-21-2010, 12:26 PM

Here is a sample file with the code. Let me know if this helps.

lienlee

07-22-2010, 07:54 AM

Here is a sample file with the code. Let me know if this helps. See attachment on sample data what i need help with.

i bolded it for each column. assume its entire column. if possible can i do it on the same sheet but the new data is past column d?

Thanks!

i bolded it for each column. assume its entire column. if possible can i do it on the same sheet but the new data is past column d?

Thanks!

EDGE

07-24-2010, 07:04 PM

To handle the items in Column A you can apply the following code. It will place the new data in column D.

Sub ColumnA()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

xRow = 1

Do While ws.Cells(xRow, 1).Value <> ""

If Right(ws.Cells(xRow, 1), 4) = ".doc" Then

ws.Cells(xRow, 4).Value = Left(ws.Cells(xRow, 1).Value, Len(ws.Cells(xRow, 1).Value) - 4)

End If

xRow = xRow + 1

Loop

End Sub

However I want to make sure I understand what you want done with column B. Are you only wanting to return the IA and 3 digits or are you wanting to return the entire cell without the / ? If you can send me what you want the end data to look like for cell B I can see what I can do.

Sub ColumnA()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

xRow = 1

Do While ws.Cells(xRow, 1).Value <> ""

If Right(ws.Cells(xRow, 1), 4) = ".doc" Then

ws.Cells(xRow, 4).Value = Left(ws.Cells(xRow, 1).Value, Len(ws.Cells(xRow, 1).Value) - 4)

End If

xRow = xRow + 1

Loop

End Sub

However I want to make sure I understand what you want done with column B. Are you only wanting to return the IA and 3 digits or are you wanting to return the entire cell without the / ? If you can send me what you want the end data to look like for cell B I can see what I can do.

lienlee

07-26-2010, 05:55 AM

To handle the items in Column A you can apply the following code. It will place the new data in column D.

Sub ColumnA()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

xRow = 1

Do While ws.Cells(xRow, 1).Value <> ""

If Right(ws.Cells(xRow, 1), 4) = ".doc" Then

ws.Cells(xRow, 4).Value = Left(ws.Cells(xRow, 1).Value, Len(ws.Cells(xRow, 1).Value) - 4)

End If

xRow = xRow + 1

Loop

End Sub

However I want to make sure I understand what you want done with column B. Are you only wanting to return the IA and 3 digits or are you wanting to return the entire cell without the / ? If you can send me what you want the end data to look like for cell B I can see what I can do.

I attached the end data

Sub ColumnA()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

xRow = 1

Do While ws.Cells(xRow, 1).Value <> ""

If Right(ws.Cells(xRow, 1), 4) = ".doc" Then

ws.Cells(xRow, 4).Value = Left(ws.Cells(xRow, 1).Value, Len(ws.Cells(xRow, 1).Value) - 4)

End If

xRow = xRow + 1

Loop

End Sub

However I want to make sure I understand what you want done with column B. Are you only wanting to return the IA and 3 digits or are you wanting to return the entire cell without the / ? If you can send me what you want the end data to look like for cell B I can see what I can do.

I attached the end data

EDGE

07-26-2010, 09:54 AM

This should do the trick

Sub ColumnB()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

Dim x As Variant

Dim xCnt As Integer

Dim Pos1 As Integer, Pos2 As Integer

Dim spPos1 As Integer, spPost2 As Integer

xRow = 1

Do While ws.Cells(xRow, 2).Value <> ""

x = Split(ws.Cells(xRow, 2).Value, "\")

xCnt = UBound(x)

For i = 0 To UBound(x)

If x(i) <> "" Then

Pos1 = InStr(x(i), "IA")

spPos1 = InStr(1, x(i), " ") ' Find the first space after the IA

If xCnt > 2 Then

Pos2 = InStr(x(i + 1), "IA")

spPos2 = InStr(1, x(i + 1), " ") ' Find the first space after the IA

If Pos1 > 0 And Pos2 > 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

ElseIf Pos1 = 0 And Pos2 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

Else

If Pos1 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

End If

End If

Next i

xRow = xRow + 1

Loop

Set x = Nothing

End Sub

Sub ColumnB()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

Dim x As Variant

Dim xCnt As Integer

Dim Pos1 As Integer, Pos2 As Integer

Dim spPos1 As Integer, spPost2 As Integer

xRow = 1

Do While ws.Cells(xRow, 2).Value <> ""

x = Split(ws.Cells(xRow, 2).Value, "\")

xCnt = UBound(x)

For i = 0 To UBound(x)

If x(i) <> "" Then

Pos1 = InStr(x(i), "IA")

spPos1 = InStr(1, x(i), " ") ' Find the first space after the IA

If xCnt > 2 Then

Pos2 = InStr(x(i + 1), "IA")

spPos2 = InStr(1, x(i + 1), " ") ' Find the first space after the IA

If Pos1 > 0 And Pos2 > 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

ElseIf Pos1 = 0 And Pos2 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

Else

If Pos1 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

End If

End If

Next i

xRow = xRow + 1

Loop

Set x = Nothing

End Sub

lienlee

07-26-2010, 10:16 AM

This should do the trick

Sub ColumnB()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

Dim x As Variant

Dim xCnt As Integer

Dim Pos1 As Integer, Pos2 As Integer

Dim spPos1 As Integer, spPost2 As Integer

xRow = 1

Do While ws.Cells(xRow, 2).Value <> ""

x = Split(ws.Cells(xRow, 2).Value, "\")

xCnt = UBound(x)

For i = 0 To UBound(x)

If x(i) <> "" Then

Pos1 = InStr(x(i), "IA")

spPos1 = InStr(1, x(i), " ") ' Find the first space after the IA

If xCnt > 2 Then

Pos2 = InStr(x(i + 1), "IA")

spPos2 = InStr(1, x(i + 1), " ") ' Find the first space after the IA

If Pos1 > 0 And Pos2 > 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

ElseIf Pos1 = 0 And Pos2 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

Else

If Pos1 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

End If

End If

Next i

xRow = xRow + 1

Loop

Set x = Nothing

End Sub Thanks so much!!! that helped.

IA275 - ECShipping InstructionsECShipping

IA275 - ECShipping InstructionsECShipping

IA112 - Suppliers Schedule112c - Suppliers Schedule - Manu 7.2some reason these 3 didnt turn out quite well and this was the output. the rest of the data worked perfectly!

IA IA112 - Suppliers Schedule

IA IA275 - ECShipping Instructions

IA IA275 - ECShipping Instructionsi wish there was a rep button. so i can rep you for your help

Sub ColumnB()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

Dim x As Variant

Dim xCnt As Integer

Dim Pos1 As Integer, Pos2 As Integer

Dim spPos1 As Integer, spPost2 As Integer

xRow = 1

Do While ws.Cells(xRow, 2).Value <> ""

x = Split(ws.Cells(xRow, 2).Value, "\")

xCnt = UBound(x)

For i = 0 To UBound(x)

If x(i) <> "" Then

Pos1 = InStr(x(i), "IA")

spPos1 = InStr(1, x(i), " ") ' Find the first space after the IA

If xCnt > 2 Then

Pos2 = InStr(x(i + 1), "IA")

spPos2 = InStr(1, x(i + 1), " ") ' Find the first space after the IA

If Pos1 > 0 And Pos2 > 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

ElseIf Pos1 = 0 And Pos2 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

Else

If Pos1 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

End If

End If

Next i

xRow = xRow + 1

Loop

Set x = Nothing

End Sub Thanks so much!!! that helped.

IA275 - ECShipping InstructionsECShipping

IA275 - ECShipping InstructionsECShipping

IA112 - Suppliers Schedule112c - Suppliers Schedule - Manu 7.2some reason these 3 didnt turn out quite well and this was the output. the rest of the data worked perfectly!

IA IA112 - Suppliers Schedule

IA IA275 - ECShipping Instructions

IA IA275 - ECShipping Instructionsi wish there was a rep button. so i can rep you for your help

EDGE

07-26-2010, 10:36 AM

I figured there would be some issues. Send me what the data looks like in the file for these three and I will have a look.

lienlee

07-26-2010, 10:43 AM

I figured there would be some issues. Send me what the data looks like in the file for these three and I will have a look.

I highlighted the data.

I highlighted the data.

EDGE

07-26-2010, 03:12 PM

I do not see this issue when I execute the macro. It returns the following values:

IA112

IA275

IA275

IA112

IA275

IA275

lienlee

07-27-2010, 12:04 PM

I do not see this issue when I execute the macro. It returns the following values:

IA112

IA275

IA275

Sorry i put the wrong data. here is this correct one

IA112

IA275

IA275

Sorry i put the wrong data. here is this correct one

EDGE

07-27-2010, 03:09 PM

I added an additional If statement to handle this scenario

If Pos1 > 0 And Pos2 = 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Total Sub:

Sub ColumnB()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

Dim x As Variant

Dim xCnt As Integer

Dim Pos1 As Integer, Pos2 As Integer

Dim spPos1 As Integer, spPost2 As Integer

xRow = 1

Do While ws.Cells(xRow, 2).Value <> ""

x = Split(ws.Cells(xRow, 2).Value, "\")

xCnt = UBound(x)

For i = 0 To UBound(x)

If x(i) <> "" Then

Pos1 = InStr(x(i), "IA")

spPos1 = InStr(1, x(i), " ") ' Find the first space after the IA

If xCnt > 2 Then

Pos2 = InStr(x(i + 1), "IA")

spPos2 = InStr(1, x(i + 1), " ") ' Find the first space after the IA

If Pos1 > 0 And Pos2 = 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

ElseIf Pos1 > 0 And Pos2 > 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

ElseIf Pos1 = 0 And Pos2 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

Else

If Pos1 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Else

' MsgBox "Count < 3"

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

End If

End If

Next i

xRow = xRow + 1

Loop

Set x = Nothing

End Sub

If Pos1 > 0 And Pos2 = 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Total Sub:

Sub ColumnB()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

Dim x As Variant

Dim xCnt As Integer

Dim Pos1 As Integer, Pos2 As Integer

Dim spPos1 As Integer, spPost2 As Integer

xRow = 1

Do While ws.Cells(xRow, 2).Value <> ""

x = Split(ws.Cells(xRow, 2).Value, "\")

xCnt = UBound(x)

For i = 0 To UBound(x)

If x(i) <> "" Then

Pos1 = InStr(x(i), "IA")

spPos1 = InStr(1, x(i), " ") ' Find the first space after the IA

If xCnt > 2 Then

Pos2 = InStr(x(i + 1), "IA")

spPos2 = InStr(1, x(i + 1), " ") ' Find the first space after the IA

If Pos1 > 0 And Pos2 = 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

ElseIf Pos1 > 0 And Pos2 > 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

ElseIf Pos1 = 0 And Pos2 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

Else

If Pos1 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Else

' MsgBox "Count < 3"

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

End If

End If

Next i

xRow = xRow + 1

Loop

Set x = Nothing

End Sub

lienlee

07-28-2010, 07:23 AM

I added an additional If statement to handle this scenario

If Pos1 > 0 And Pos2 = 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Total Sub:

Sub ColumnB()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

Dim x As Variant

Dim xCnt As Integer

Dim Pos1 As Integer, Pos2 As Integer

Dim spPos1 As Integer, spPost2 As Integer

xRow = 1

Do While ws.Cells(xRow, 2).Value <> ""

x = Split(ws.Cells(xRow, 2).Value, "\")

xCnt = UBound(x)

For i = 0 To UBound(x)

If x(i) <> "" Then

Pos1 = InStr(x(i), "IA")

spPos1 = InStr(1, x(i), " ") ' Find the first space after the IA

If xCnt > 2 Then

Pos2 = InStr(x(i + 1), "IA")

spPos2 = InStr(1, x(i + 1), " ") ' Find the first space after the IA

If Pos1 > 0 And Pos2 = 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

ElseIf Pos1 > 0 And Pos2 > 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

ElseIf Pos1 = 0 And Pos2 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

Else

If Pos1 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Else

' MsgBox "Count < 3"

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

End If

End If

Next i

xRow = xRow + 1

Loop

Set x = Nothing

End Sub

Thanks =) works perfectly

If Pos1 > 0 And Pos2 = 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Total Sub:

Sub ColumnB()

Dim ws As Worksheet

Set ws = ThisWorkbook.Sheets("Sheet1")

Dim x As Variant

Dim xCnt As Integer

Dim Pos1 As Integer, Pos2 As Integer

Dim spPos1 As Integer, spPost2 As Integer

xRow = 1

Do While ws.Cells(xRow, 2).Value <> ""

x = Split(ws.Cells(xRow, 2).Value, "\")

xCnt = UBound(x)

For i = 0 To UBound(x)

If x(i) <> "" Then

Pos1 = InStr(x(i), "IA")

spPos1 = InStr(1, x(i), " ") ' Find the first space after the IA

If xCnt > 2 Then

Pos2 = InStr(x(i + 1), "IA")

spPos2 = InStr(1, x(i + 1), " ") ' Find the first space after the IA

If Pos1 > 0 And Pos2 = 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

ElseIf Pos1 > 0 And Pos2 > 0 Then ' compare the array elements

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

ElseIf Pos1 = 0 And Pos2 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i + 1), spPos2 - 1)

Exit For

Else

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

Else

If Pos1 > 0 Then

ws.Cells(xRow, 4).Value = Left(x(i), spPos1 - 1)

Exit For

Else

' MsgBox "Count < 3"

ws.Cells(xRow, 4).Value = "IA " & x(i)

Exit For

End If

End If

End If

Next i

xRow = xRow + 1

Loop

Set x = Nothing

End Sub

Thanks =) works perfectly

Powered by vBulletin® Version 4.2.5 Copyright © 2020 vBulletin Solutions Inc. All rights reserved.