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
Related
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,""))
I am trying to write a function in Excel that:
Iterates through each worksheet
Checks if the supplied string exists in the supplied cell
Adds a predetermined cell value to the return value if step 2 evaluates to True
I've been stepping through my function and am getting the correct values until the function has to add the 4th cell to my return value.
Anyone have any idea what's going on? Thanks!
Function Revenue(row As Integer, col As Integer, str As String) As Integer
Dim i As Integer
For i = 2 To Worksheets.Count
If Worksheets(i).Cells(row, col) = str Then
Revenue = Revenue + Worksheets(i).Cells(21, 2) // Bug occurs on 4th iteration
Debug.Print Revenue
End If
Next i
End Function
You need to establish values for row and col prior to using them.
I am trying to compare two data series with dates and on a third column show ONLY the dates that are common in both data series (ordered in descending mode). A friend of mine helped me put together some code that seems to work but it seems to be taking a long time to generate the result when I have quite a long series of data. Is there a way to write this code differently that might get calculated faster? (I am currently using excel 2010.
The Function I enter on D2 and then I copy it down is: =next_duplicate(A2:$A$535,B2:$B$535,D1:$D$1)
Function next_duplicate(list1, list2, excluded)
For Each c In list1
If WorksheetFunction.CountIf(excluded, c) = 0 Then
If WorksheetFunction.CountIf(list2, c) > 0 Then
next_duplicate = c
Exit For
End If
End If
Next c
If next_duplicate = 0 Then
next_duplicate = "N/A"
End If
End Function
You can do this without VBA.
In Column C use COUNTIF to extract dates that appear only in both Columns A and B
=IF(COUNTIF($B$2:$B$7,"="&A2) > 0, A2, 0)
Then in Column D use an array formula (from here) to sort and remove blanks. Don't forget to select the range and then press control, shift and enter.
=INDEX(C2:C7, MATCH(LARGE(IF(ISBLANK(C2:C7), "", IF(ISNUMBER(C2:C7), COUNTIF(C2:C7, "<"&C2:C7), COUNTIF(C2:C7, "<"&C2:C7)+SUM(IF(ISNUMBER(C2:C7), 1, 0))+1)), ROW()-ROW($D$2)+1), IF(ISBLANK(C2:C7), "", IF(ISNUMBER(C2:C7), COUNTIF(C2:C7, "<"&C2:C7), COUNTIF(C2:C7, "<"&C2:C7)+SUM(IF(ISNUMBER(C2:C7), 1, 0))+1)), 0))
If #Dan's solution works, go with that since formula solutions are usually cooler :) If you need to use VBA, you can try this:
Sub Common()
Dim Date1 As Range
Dim Date2 As Range
Dim CommonDates() As Variant
Dim UniqueDates As New Collection
Set Date1 = Range("A2:A6")
Set Date2 = Range("B2:B6")
' Change the max array size to equal the length of Date1
' This is arbitrary and could be more efficient, for sure :)
ReDim CommonDates(Date1.Count)
' Set a counter that will increment with matches
i = 0
' Since a match needs to be in both, iterate through Date1 and check
' if the Match function returns a True value when checking Date2.
' If so, add that value to the CommonDates array and increment the counter.
For Each DateVal In Date1
If IsError(Application.Match(DateVal, Date2, 0)) = False Then
CommonDates(i) = DateVal.Value
i = i + 1
End If
Next
' Filter out dupes (in case that is possible - if not, this can be removed
' and the bottom part reworked
On Error Resume Next
For Each Value In CommonDates
UniqueDates.Add Value, CStr(Value)
Next Value
' Now go to the first cell in your Common Dates range (I'm using C2) and
' print out all of the results
Range("C2").Activate
For j = 1 To UniqueDates.Count
ActiveCell.Value = UniqueDates(j)
ActiveCell.Offset(1).Activate
Next j
' Back to the beginning
Range("C2").Activate
' Use this if you don't need to filter dupes
'For Each r In CommonDates
' ActiveCell.Value = r
' ActiveCell.Offset(1).Activate
'Next
End Sub
It basically iterates over Date1 and checks if the Match formula succeeds/fails in Date2. A success = match, which means a common date. Those are then printed to another column. Hope this helps!
I have a column that contains strings with values that i want to search.
Example:
Column A (my raw data): SMS APP, SMS Solutions
Column B (my search criterias):SMS
Column C: =vlookup(Column B, Column C, FALSE)
As shown above, I would like to ensure that Column C will display the results of my search on my raw data. Is there a vlookup way to do it?. It must match a string shown in Column B. thanks!
If you want a full blown UDF that will give you back a list of all the cells that contained the word in B then (note this works with multi-column ranges as well):
=ListAll(B1, A1:A100)
(code)
Function ListAll(ByVal text As String, _
ByVal cell_range As Range, _
Optional seperator As String = ", ") As String
Dim result As String
Dim i As Long, j as Long
Dim rawData As Variant
rawData = cell_range.Value
For i = 1 To UBound(rawData, 1)
For j = 1 To UBound(rawData, 2)
If InStr(1, rawData(i, j), text) <> 0 Then
result = result & (rawData(i, j) & seperator)
End If
Next
Next
If Len(result) <> 0 Then
result = Left$(result, Len(result) - Len(seperator))
End If
ListAll = result
End Function
Notice I set it up so that each value found is seperated by a comma, but you can do other stuff like line breaks:
=ListAll(B1, A1:A100, CHAR(10))
You can also do this with the =SEARCH(find_text, within_text) formula, which returns an integer if find_text is found within_text, and returns #VALUE! if the text is not found. So, just make column D which searches values in column A for values in Column B. If column D is integer, that means match. If column D is #VALUE - no match.
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