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)
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
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
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
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:
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
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.
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?
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!
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
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
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
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
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 do not see this issue when I execute the macro. It returns the following values:
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
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
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.