I just wonder how to calculate this in vba:
Calculate the first amount of money if it is yes but not calculate the amount if it is no. Imagine there are four cells:
(cell 1) abcbc bcbcbcb cbcbcbc $1000/kskskksks/$2000//1222/1221/11/yes
(cell 2) any words will be here $2300/heyhey hey/ //3232//3232/no
(cell 3) kakjsak dsdsk kdjskj 2323/ $23232/hhehe 22/33/333/yes
(cell 4) kakaka kjsdkj ksjskjds kdjsjkdj 11 223 222/ $1121/ $2121/yes
The algorithm is to check whether is yes or no. Then, on each line, find the first money, beginning with $, the second money on the same line would not take into account.
In this example, the program will take $1000 into account, because it is yes, second line would not be executed since it is no. And the third cell would take the first money (first $), $23232. So, the program will sum $1000+$23232+$1121=$25353
I guess that this is what you want, considering that you are using the first column to place each value and your sheet's name is "Sheet1"
Sub SumFirstAmountIfYes()
Dim AmountSum As Variant ' Declares the AmountSum
lastRow = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Row ' Finds the last used row on the first column
For i = 1 To lastRow ' Iterates over the rows to the last row
StringValue = Sheets("Sheet1").Cells(i, 1).Value2 ' Gets the value to a variable
If StringValue Like "*yes" Then ' Checks if the string terminates with "yes"
FirstDollar = InStr(StringValue, "$") ' Finds first dollar symbol "$"
FirstSlashAfterDollar = InStr(FirstDollar, StringValue, "/", 0) ' Finds first slash "\" after the first dollar symbol
FirstAmount = Mid(StringValue, FirstDollar + 1, FirstSlashAfterDollar - FirstDollar - 1) ' Gets the amount of each row
AmountSum = AmountSum + CDec(FirstAmount) ' Adds to the sum variable each found amount
End If
Next
MsgBox (AmountSum) ' Shows the final sum of the amounts
End Sub
This uses split to isolate yes/no and InStr to locate the first currency symbol.
Sub sumYes()
Dim i As Long, str As String, dbl As Double
With Worksheets("Sheet10")
For i = 2 To .Cells(.Rows.Count, "A").End(xlUp).Row
str = LCase(.Cells(i, "A").Value2)
If Split(str, "/")(UBound(Split(str, "/"))) = "yes" Then
If CBool(InStr(1, str, Chr(36))) Then
dbl = dbl + Val(Mid(str, InStr(1, str, Chr(36)) + 1))
End If
End If
Next i
.Cells(2, "B") = dbl
End With
End Sub
Slightly different approach which uses excel array formula assuming your cell values doesn't contain trailing spaces ,
=SUM(IF(RIGHT(A1:A4,1)="s",MID(A1:A4,SEARCH("$",A1:A4)+1,SEARCH("/",A1:A4,SEARCH("$",A1:A4))-SEARCH("$",A1:A4)-1)*1,""))
Related
I have been working on a project for work where I create room lists based on ranges i.e. 1-3,5 returns 1,2,3,5 in new rows on another sheet. I even was able to read another set of ranges from another cell and compare it for doubles. so it the second cell was 1-3 the list would be, 1A, 1B, 2A, 2B, 3A, 3B, 5A. The next step will be to compare numbers in the first range to determine prefixes and suffixes, assign them to a variable, remove them, do the comparisons and re-insert them when writing rows. A good example of a range would be 5N01-5N05 would need to return 5n01, 5n02, 5n03, 5n04, 5n05. Another example of a range would be 10011-X - 10015-x would need to return 10011-x, 10012-x 10013-x, 10014-x, 10015-x
Any help would be appreciated. I have seen examples that have just split all text and numbers but have not stored the number
In my head I would need to write a formula that grabs the first two numbers, starts at the left, makes notes of the position it is comparing and goes down the line until it hits a unique value. The position can be fed back to read the first however many characters and delete them before entering the range formula and then reinserting when writing the list. The same would be done starting from the right to determine suffix so in the last room list it would go
(10011-x - 10015-x)
Left most character 1 is 1, matches both 1st positions, move to next
Next character 2 is 0, matches both 2nd positions, move to next
Next character 3 is 0, matches both 3rd positions, move to next
Next character 4 is 1, matches both 4th positions, move to next
-Next character 5 is 1, does not match both 5th positions, stop
Prefix = characters 1-4 of first number, 1001
Rightmost character 7 is x, matched both 7th position, move to next
-next character 6 is "-", matches both 6th positions, move to next
next character 5 is 1, does not match both 5th positions, stop
suffix = characters 6-7 of first number, -x
That's where I need help. From there I could manage to extract the true range
1-5 after the prefix and suffix is removed and populate them in the list at the end.
Sorry for the broadness. Just have a lot of moving pieces on this doc
I created some code to compare entries and spit out the prefixes and suffixes of room numbers
Here it is. The next step is incorporating this into my other Sub that can read ranges like (1-5,7,9) I want to be able for it to read (3N01-X-3N05-X, 3N07-X)
and I think with the comparing Sub below I am a little closer. I will try to be more direct with my next questions when I post a new one but this is answered
Sub Prefix()
Sheet7.Range("B1").Select
Dim Entry1 As String
Dim Entry2 As String
Dim currentCharacter As String
Dim currentCharacter2 As String
Dim pCount As Integer
Dim pCurrent As String
Dim Prefix As String
Dim pArray(1 To 10) As String
Dim sCount As Integer
Dim sCurrent As String
Dim Suffix As String
Dim sArray(1 To 10) As String
Entry1 = ActiveSheet.Cells.Range("B" & ActiveCell.Row).Value
Entry2 = ActiveSheet.Cells.Range("C" & ActiveCell.Row).Value
For pCount = 1 To Len(Entry1)
currentCharacter = Mid(Entry1, pCount, 1)
currentCharacter2 = Mid(Entry2, pCount, 1)
If currentCharacter = currentCharacter2 Then
pArray(pCount) = currentCharacter
NextRow2 = Sheet7.Cells(Rows.Count, "G").End(xlUp).Row + 1
Sheet7.Cells(NextRow2, "G") = currentCharacter
Else
Prefix = Join(pArray, "")
MsgBox Prefix
GoTo Suffix
End If
Next
Suffix:
For sCount = 1 To Len(Entry1)
currentCharacter = Right(Entry1, sCount)
currentCharacter2 = Right(Entry2, sCount)
If currentCharacter = currentCharacter2 Then
sArray(sCount) = currentCharacter
NextRow2 = Sheet7.Cells(Rows.Count, "G").End(xlUp).Row + 1
Sheet7.Cells(NextRow2, "G") = currentCharacter
Suffix = currentCharacter
Else
MsgBox Suffix
Exit Sub
End If
Next
End Sub
I have a spreadsheet with a load of random text and numbers in column A like so:
Column A
Row 1 = 471806121601 5205569 - 0007 Standard White Toilet Tissue 27
Row 2 = 471814121601 5206177 - 0014 Premium White Toilet Tissue 6
Row 3 = 471814121601 5206178 - 0007 Premium White Toilet Tissue 27
Row 4 = 471806121601 5206180 - 0014 Premium Kitchen Towel 2x75l 6
I have about 2000 lines in total. In each cell, is a Purchase order number (12 digits) and an item number next to it (7 digits).
I am trying to extract the po number and put it into column B and extract the item number and put it into column C
Column B Column C
471806121601 5205569
471814121601 5206177
471814121601 5206178
471806121601 5206180
Here is my code:
Option Explicit
Sub main()
Dim cell As Range
Dim arr As Variant, arrElem As Variant
With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
For Each cell In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
arr = Split(Replace(cell.Value, " ", " "), " ") '<--| change "A"'s to your actual relevant column index
For Each arrElem In arr
If IsNumeric(arrElem) Then
If Len(arrElem) = 12 Then cell.Offset(0, 1).Value = arrElem
End If
Next arrElem
Next cell
End With
Dim cell2 As Range
Dim arr2 As Variant, arrElem2 As Variant
With Worksheets("Orders") '<--| change "Strings" to your actual worksheet name
For Each cell2 In .Range("A1", .Cells(.Rows.Count, "A").End(xlUp))
arr2 = Split(Replace(cell2.Value, " ", " "), " ") '<--| change "A"'s to your actual relevant column index
For Each arrElem2 In arr2
If IsNumeric(arrElem2) Then
If Len(arrElem2) = 7 Then cell2.Offset(0, 3).Value = arrElem2
End If
Next arrElem2
Next cell2
End With
End Sub
This code does work. However it takes absolutely ages and only does one line at a time...Slowly.
Is there a quicker way of doing this? Thanks
If your PO and IN are always the same length in col B put
=MID(A2, 1, 12)
And in col C
=MID(A2, 14, 7)
However if your number change but are always the first two swap the above for,
=MID(A2,1,FIND(" ",A2,1)-1)
And
=MID(A2, FIND(" ", A2, 1)+1, 7)
Respectively.
just use split(string,delimiter)(0) and (1) why replace the space, just use that as the delim. If Row # is in, then use (1) and (2), or you could consider split(split(input,"-")," ") maybe a little faster, not sure though. Also, once you're done no need to complete the loop, so consider, do until with flags rather than for next, although exit for is available
Formula wise, it could be done using something like this
=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",3)),FIND("é",SUBSTITUTE(D1," ","é",4))-FIND("é",SUBSTITUTE(D1," ","é",3)))
and
=MID(D1,FIND("é",SUBSTITUTE(D1," ","é",4)),FIND("é",SUBSTITUTE(D1," ","é",5))-FIND("é",SUBSTITUTE(D1," ","é",4)))
I need to parse out a list of tracking numbers from text in excel. The position in terms of characters will not always be the same. An example:
Location ID 987
Your package is arriving 01/01/2015
Fruit Snacks 706970554628
<http://www.fedex. com/Tracking?tracknumbers=706970554628>
Olive Oil 709970554631
<http://www.fedex. com/Tracking?tracknumbers=709970554631>
Sign 706970594642
<http://www.fedex .com/Tracking?tracknumbers=706970594642>
Thank you for shopping with us!
The chunk of text is located in one cell. I would like the results to either be 3 separate columns or rows looking like this:
706970554628 , 709970554631 , 706970594642
There will not always be the same number of tracking numbers. One cell might have six while another has one.
Thank you for any help!!
I think you'll need some VBA to do this. And it's not going to be super simple stuff. #Gary'sStudent has a great example of grabbing numbers from a big string. If you need something that is more specific to your scenario you'll have to parse the string word by word and have it figure out when it encounters a tracking number in the URL.
Something like the following will do the trick:
Function getTrackingNumber(bigMessage As String, numberPosition As Integer) As String
Dim intStrPos As Integer
Dim arrTrackNumbers() As Variant
'create a variable to hold characters we'll use to identify words
Dim strWorkSeparators As String
strWordSeparators = "()=/<>?. " & vbCrLf
'iterate through each character in the big message
For intStrPos = 1 To Len(bigMessage)
'Identify distinct words
If InStr(1, strWordSeparators, Mid(bigMessage, intStrPos, 1)) > 1 Then 'we found the start of a new word
'if foundTrackNumber is true, then this must be a tracking number. Add it to the array of tracking numbers
If foundTrackNumber Then
'keep track of how many we've found
trackNumbersFound = trackNumbersFound + 1
'redim the array in which we are holding the track numbers
ReDim Preserve arrTrackNumbers(0 To trackNumbersFound - 1)
'add the track
arrTrackNumbers(trackNumbersFound - 1) = strword
End If
'Check to see if the word that we just grabbed is "tracknumber"
If strword = "tracknumbers" Then
foundTrackNumber = True
Else
foundTrackNumber = False
End If
'set this back to nothing
strword = ""
Else
strword = strword + Mid(bigMessage, intStrPos, 1)
End If
Next intStrPos
'return the requested tracking number if it exists.
If numberPosition > UBound(arrTrackNumbers) + 1 Then
getTrackingNumber = ""
Else
getTrackingNumber = arrTrackNumbers(numberPosition - 1)
End If
End Function
This is a UDF, so you can use it in your worksheet as a formula with:
=getTrackingNumber(A1, 1)
Which will return the first tracking number it encounters in cell A1. Consequently the formula
=getTrackingNumber(A1, 2)
will return the second tracking number, and so on.
This is not going to be a speedy function though since it's parsing the big string character by character and making decisions as it goes. If you can wrangle Gary's Student's answer into something workable it'll be much faster and less CPU intensive on larger data. However, if you are getting too many results and need to go at this like a surgeon, then this should get you in the ballpark.
If tracking is always a 12 digit number, then select the cell run run this short macro:
Sub parser117()
Dim s As String, ary, i As Long
With ActiveCell
ary = Split(Replace(Replace(.Text, Chr(10), " "), Chr(13), " "), " ")
i = 1
For Each a In ary
If Len(a) = 12 And IsNumeric(a) Then
.Offset(0, i).Value = a
i = i + 1
End If
Next a
End With
End Sub
I'm developing a VBA function for Excel. It will take input parameters of an integer (we'll call it ref_num), and a range. It will search through the range, looking for ref_num as the value of a cell. When it finds ref_num (which may or may not be present), it will go to the second row of the column that ref_num is in, and store that value as a string in the return variable (the value is a date, and 1-31 each have their own column). Every time ref_num is found in a column, the value in the second row will be appended to the return string.
Slightly more concrete example:
ref_num is 2, and 2 occurs in columns A, B, and C. The values in A2, B2, and C2 are 1, 2, and 3, respectively, so the function must return "1, 2, 3".
This is my pseudo-code, but I need some help filling in the blanks...
Note that this currently does not work, and that the algorithm is very much brute force. I just want to get something working.
Function GetDays(ref_num As Integer, range_o_cells As Range) As String
Dim num_dates As Integer
Dim day As String
Set num_dates = 0
'iterate through all the cells and see if the value is ref_num
For Each c In range_o_cells
If c.Value = ref_num Then
'get the cell's column, then reference the second row and get the value. Note that this will be an int that we need to convert to a string
'I seriously doubt the following line will work
day = CStr(Cells(c.Column, 2).Value)
'Once you have the value, append it to the return value
If num_dates = 0 Then
'This is the first value we've found, so we don't need to prepend a comma
GetDays = day
num_dates = 1
Else
'This is probably not valid VBA syntax...
GetDays = GetDays & ", " & day
End If
Next c
End Function
Note that currently, if I call it like this: =GetDays(AG39, $P$3:$W$500) where AG39 is the cell containing ref_num, I get #NUM!
There are multiple issues in your code
You don't use Set for integers
Missing an End If
As you suspected, your indexing into Cells is iffy
You should build your return string into day and assign it to the function in one place
Looping over a range is Slow
You should declare all variables
Better approach is to move the data to a variant array, and loop that. Also include the header data in the range passed to range_o_cells (I'm guessing thats $P$1:$W$500)
Here's your code refactored
Function GetDays( _
ref_num As Long, _
range_o_cells As Range, _
Optional Sep As String = ", ") As String
Dim dat As Variant
Dim rw As Long, col As Long
Dim day As String
dat = range_o_cells.Value
For col = 1 To UBound(dat, 2)
For rw = 3 To UBound(dat, 1)
If dat(rw, col) = ref_num Then
day = day & dat(2, col) & Sep
End If
Next rw, col
If Len(day) > 0 Then day = Left$(day, Len(day) - Len(Sep))
GetDays = day
End Function
I'm trying to write a code that deletes all rows between the 3rd and last data row on a worksheet. I have some short lines of code that first looks for the last row containing data, returns that row number. Subtracts 1 from it. And selects the data range from 3rd row to the 2nd to last row and attempts to delete them. But I run into error every time I run this code. Any suggestions?
Sheets("Sheet1").Activate
lastrow = (Sheet1.Range("A1").Offset(Sheet1.Rows.Count - 1, 0).End(xlUp).Row) - 1
Range("3: lastrow").Select 'Error 1004: method range of object _global failed
Selection.Delete Shift:=xlUp
Using the SpecialCells property of the range:
Range("A3:" & Range("A1").SpecialCells(xlCellTypeLastCell).Address).Select
This will select the block up until the last used cell.
Edit:
To incorporate it into your program to get the second to last, do some string manipulations on the last cell.
Dim str, str1, str2, add As String
Dim index, num As Integer
str = Range("A1").SpecialCells(xlCellTypeLastCell).Address 'returns say $j$20
index = InStr(2, str, "$") 'find the second dollar sign
str1 = Left(str, index) 'gets the string "$j$"
str2 = Mid(str, index + 1) 'get the string "20"
num = CInt(str2) 'convert "20" to 20
num = num - 1
add = str1 & CStr(num) 'reattach to form "$j$19"
Range("A3:" & add).Select