Solved: Excel VBA

[lienlee]

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]

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

[Aflatoon]

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

[lienlee]

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

[lienlee]

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:

[EDGE]

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

[lienlee]

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.

[EDGE]

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?

[EDGE]

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

[lienlee]

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!

[EDGE]

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.

[lienlee]

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

[EDGE]

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

[lienlee]

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

[EDGE]

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]

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.

[EDGE]

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

IA112
IA275
IA275

[lienlee]

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

[EDGE]

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

[lienlee]

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