I'm brand new to using VBA within excel. I'm not even 100% sure on how to insert a module correctly to begin with so this will be a big help.
I've set up a worksheet that randomizes a number between 1 and 100.
B3 =RANDBETWEEN(C6,F6)
I have 13 contestants. Each gets to guess a number. Goal is to be closest to the randomized number. (Guess a number between x & y. Closest wins "The Prize")
Contestants are listed in A9:B21. (i.e; "Contestant #1")
Their guesses are listed in C9:C21.
The difference between the randomized number and the guess is listed in D9:D21
D9:D21 =IF(C9>$B$3,C9-$B$3,IF($B$3>C9,$B$3-C9,0))
Cells F9:F21 let you know who won and doesn't count any guesses that are less than 1 and more than 100.
F9:F21 =IF(C9<1,,IF(C9>100,,IF(D9=MIN($D$9:$D$21),A9&" Wins",)))
Unfortunately, every time I try to reference in cell C6 or F6 instead of 1 or 100 I only get the result of 0.
In F8 I have a notification that pops up if there is a tie. Still not sure if this code is the best way to do this.
F8 =IF(COUNTIF(F9:F21,"*")>1,"Tie Breaker Needed","")
Here's my question. I know how to recognize duplicates and I can highlight them if I want to. I can't seem to find a way to have a single cell tell me exactly who has won even if there is a tie.
I.e; If Contestant #7 Wins --- Cell would say "Contestant #7 Wins"
If Contestants #7 & #10 win --- Cell should say Contestant #7 & Contestant #10 Tie.
Is there a command or VBA module that could do this for me? I tried the VBA module below that I found but it only returns #NAME? No matter what I do.
Either this code works and I'm not inserting the module correctly or this module doesn't work for my situation and I need something new.
Help me Oh Great Excel Sages of the Online Realm.
Image of My Excel Worksheet
Option Explicit
Function LookupCSVResults(lookupValue As Integer, lookupRange As Range, resultsRange As Range) As String
Dim s As String 'Results placeholder
Dim sTmp As String 'Cell value placeholder
Dim r As Long 'Row
Dim c As Long 'Column
Const strDelimiter = "|||" 'Makes InStr more robust
s = strDelimiter
For r = 1 To lookupRange.Rows.Count
For c = 1 To lookupRange.Columns.Count
If lookupRange.Cells(r, c).Value = lookupValue Then
'I know it's weird to use offset but it works even if the two ranges
'are of different sizes and it's the same way that SUMIF works
sTmp = resultsRange.Offset(r - 1, c - 1).Cells(1, 1).Value
If InStr(1, s, strDelimiter & sTmp & strDelimiter) = 0 Then
s = s & sTmp & strDelimiter
End If
End If
Next
Next
'Now make it look like CSV
s = Replace(s, strDelimiter, ",")
If Left(s, 1) = "," Then s = Mid(s, 2)
If Right(s, 1) = "," Then s = Left(s, Len(s) - 1)
LookupCSVResults = s 'Return the function
End Function
How about the following UDF():
Option Explicit
Public Function ListWinners(people As Range, deltas As Range) As String
Dim wf As WorksheetFunction
Dim i As Long, delta As Long, msg As String
Dim WinningValue As Long
Set wf = Application.WorksheetFunction
ListWinners = ""
msg = " wins"
WinningValue = wf.Min(deltas)
For i = 1 To deltas.Rows.Count
If deltas(i) = WinningValue Then
If ListWinners = "" Then
ListWinners = people(i)
Else
ListWinners = ListWinners & " & " & people(i)
msg = " tie"
End If
End If
Next i
ListWinners = ListWinners & msg
End Function
In your posted example, use it like:
=ListWinners(A9:A21,C9:C21)
to display the winner list in a single cell.
EDIT#1:
User Defined Functions (UDFs) are very easy to install and use:
ALT-F11 brings up the VBE window
ALT-I
ALT-M opens a fresh module
paste the stuff in and close the VBE window
If you save the workbook, the UDF will be saved with it.
If you are using a version of Excel later then 2003, you must save
the file as .xlsm rather than .xlsx
To remove the UDF:
bring up the VBE window as above
clear the code out
close the VBE window
To use the UDF from Excel:
=ListWinners(A1:A100,B1:B100)
To learn more about macros in general, see:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
and
http://msdn.microsoft.com/en-us/library/ee814735(v=office.14).aspx
and for specifics on UDFs, see:
http://www.cpearson.com/excel/WritingFunctionsInVBA.aspx
Macros must be enabled for this to work!
Related
I have a simple sub, where the data and the result look like this :
It's just to do a transpose value from data in column-A to column-B.
Sub test()
Dim rw1 As Long: Dim rw2 As Long: Dim cnt As Long
Dim kode1 As String: Dim kode2 As String
Dim oStop As Boolean
rw1 = 2: rw2 = 2: cnt = 1
Do
Do
If oStop = False Then
kode1 = Right(Split(Cells(rw1, 1).Value, ".")(0), 4)
kode2 = Left(kode1, 3) & LCase(Split(Columns(cnt).Address(0, 0), ":")(0))
If kode1 = kode2 Then
rw1 = rw1 + 1: cnt = cnt + 1
If Cells(rw1, 1).Value = "" Then oStop = True: kode1 = "X"
End If
End If
Loop Until kode2 <> kode1
Range("B" & Rows.Count).End(xlUp).Offset(1, 0).Resize(1, cnt - 1) = Application.Transpose(Cells(rw2, 1).Resize(cnt - 1, 1).Value)
rw2 = rw1: cnt = 1
Loop Until Cells(rw1, 1).Value = ""
End Sub
The code runs and gives the expected result without error but the problem is, sometimes after I do some editing on the sheet (like changing the data, clear cell, etc) when I run the sub again, Windows show a circular blue icon spinning for maybe 1 second, then Excel close by itself without warning. When I open again the workbook, there's no result ... so I guess there's something wrong with the code which causing Excel close by itself before it has the chance to write the transpose value to column B.
And more problem, I can't replicate the "closing by itself". I mean, after I open the workbook again, do some editing on the sheet, run the sub (expecting Excel will close by itself) but Excel not close by itself. But then later on, after I do some editing on the sheet then run the sub, Excel close again by itself.
To be honest, when I write the code - I myself feel that the code is "merry go round", too many if or maybe too many loop or maybe too long syntax. Would someone please tell me what is wrong with the code ?
I've been thinking to change the code by using findnext to find how many occurence of the looped value in column-A and then have it as cnt variable. But still I'm curious what's wrong with the sub which cause Excel close by itself.
Any kind of respond would be greatly appreciated.
Thank you in advanced.
So I have been stuck on this problem for a few days. I have looked at some others codes but I am still coming up short. I am not the best at VBA either.
I have a list of investors with their attached payments and dates. I am trying to run a command button that will go through each Account, find their related payments and dates, run the XIRR function and then place the XIRR value at the bottom to the right of each account. This is simple enough to do by hand but when you have a spreadsheet of 15000 cells+ it becomes tedious and I am trying to automate this process. It becomes difficult because each investor has different payment amounts so to find the correct location to place the XIRR value has also stumped me.
Here is an example of my spreadsheet
Dim i As Integer
Dim x As Double
Dim dateArray() As Date
Dim dateStrings() As String
Dim valArray() As Double
ReDim dateArray(Dates.Count)
ReDim valArray(Trans.Count)
ReDim dateStrings(Dates.Count)
'Sheets("InvestorList").PivotTables.GetPivotData("Account", "x") = i
'Sheets("AccountPayments").Find ("i")
End Sub
Public Function MyXIRR(Dates As Range, Trans As Range, Balance As Double)
For i = 1 To Dates.Count
dateArray(i - 1) = Dates.Item(i).Value
Next i
For i = 1 To Trans.Count
valArray(i - 1) = Trans.Item(i).Value
Next i
'Set the date on the "Balance" line to one day after the last transaction date
dateArray(Dates.Count) = DateAdd("d", 1, Dates.Item(Dates.Count))
valArray(Trans.Count) = -1 * Balance
For i = 0 To Dates.Count
dateStrings(i) = Format(dateArray(i), "mm/dd/yyyy")
Next i
MyXIRR = Application.WorksheetFunction.Xirr(valArray, dateStrings)
End Function
So I counseled with a college and he helped reduce my code to something much simpler and cleaner. I ran this code with data and it worked great. Some spot checking may be needed if an XIRR value doesn't appear right but this helps automate the process.
Private Sub CommandButton1_Click()
Dim myrow As Integer
Dim startrow As Integer
Dim valuerange As String
Dim daterange As String
Dim investor As String
myrow = 2
startrow = 2
investor = Cells(myrow, 1)
Do Until Cells(myrow, 1) = ""
If Cells(myrow + 1, 1) <> investor Then
'We are at the end of the list for the current investor.
daterange = "R" & startrow & "C2:R" & myrow & "C2"
valuerange = "R" & startrow & "C3:R" & myrow & "C3"
Cells(myrow, 4) = "=XIRR(" & valuerange & ", " & daterange & ")"
startrow = myrow + 1
investor = Cells(myrow + 1, 1)
End If
myrow = myrow + 1
Loop
End Sub
I would recommend trying the macro recorder to just record your steps... If you are unsure how to do so, here are the steps!
In Excel:
File
Options
Customize ribbon (left panel)
Choose commands from: (dropbox) select "Main Tabs"
Select developer
Click add>>
Click ok
Click developer tab now on top ribbon
Click record macro (top left corner)
Name macro, set shortcut and description if desired
Do what you want the macro to do.
When you completed it for one investor click stop recording
Click Macros in top left
Select the macro you just made and click edit
Should have a skeleton routine to work into your loop
I am writing a VBA code to go through a specified range or ranges, look for a keyword provided by the user at run-time, and grab the value in the cell offset from the cell with the keyword by an amount also provided by the user. For instance, if you wanted to look through A1:B10 for the word "Apple" and then grab the value in the cell to the right of every instance of "Apple", it can do that. Two weird things have been occurring for me. First and not so weird, when I run it and click the cancel button on the userform that only contains the single line "Unload Me", it throws an error saying it expected and End Sub statement, but it has one. I don't know why it is doing that. Weird thing number 2. Whenever I click and move the cursor to the end of the file after the Cancel_Click() sub, my excel crashes and closes. Every. Single. Time. And it is weird that it does that just from me clicking. It also sometimes happens when I click around the Cancel_Click() sub or hit enter around there too. Just simply from clicking. I don't get it. Any ideas? Code contained in the userform is below. Fyi, the user can input ranges like "A1:A10,E1:E10" separated by commas for multiple ranges. I don't think it is important for this question, but I thought I would add that since i don't know how to add the userform here, if you even can.
Private Sub Accept_Click()
'Searches for string input into the KeywordBox
'Grabs contents of the cell defined by the OffsetBox
'The range it searches through is defined by the RangeBox
Dim rawRange As String: rawRange = Me.RangeBox.Text
Dim rawOffset As String: rawOffset = Me.OffsetBox.Text
Dim Keyword As String: Keyword = Me.KeywordBox.Text
Dim numOfRanges As Integer: numOfRanges = 1
Dim Ranges() As Range
Dim commaLoc As Integer: commaLoc = -1
Dim tempRange As String: tempRange = rawRange
Dim offset As Integer
Dim values() As Double
Dim valCount As Integer: valCount = 0
'--------------------------------------------------------
'Set ranges
For i = 1 To Len(rawRange)
If (Mid(rawRange, i, 1) = ",") Then
numOfRanges = numOfRanges + 1
End If
Next
ReDim Ranges(numOfRanges) As Range
If (Not numOfRanges = 1) Then
For i = 1 To numOfRanges - 1
commaLoc = InStr(1, tempRange, ",")
Set Ranges(i) = Range(Left(tempRange, commaLoc - 1))
tempRange = Right(tempRange, Len(tempRange) - commaLoc)
Next
End If
Set Ranges(numOfRanges) = Range(tempRange)
'---------------------------------------------------------
'Set offset
If (IsNumeric(rawOffset)) Then
offset = CInt(rawOffset)
Else:
MsgBox ("Offset was not input as a number")
Exit Sub
End If
'----------------------------------------------------------
'Searches for keyword
For i = 1 To numOfRanges
For Each cell In Ranges(i)
If (cell.Value = Keyword) Then
valCount = valCount + 1
End If
Next
Next
ReDim values(valCount) As Double
valCount = 0
For i = 1 To numOfRanges
For Each cell In Ranges(i)
If (cell.Value = Keyword) Then
valCount = valCount + 1
values(valCount) = cell.offset(0, offset).Value
End If
Next
Next
For i = 1 To valCount
Range("I" & i).Value = values(i)
Next
Unload Me
End Sub
I've had similar, weird things happen to me. A good thing to try is to force the VBA project to reset, then save, exit, and restart Excel.
To force a project reset, add an Enum to the general section of one of your code modules. It doesn't matter what the enum is...make it something simple, like
Enum stoplight
Red
Yellow
Green
End Enum
As you do that, you'll get a message saying that it will reset your project. That's fine; let that happen. Then save your Excel workbook, exit excel completely, start it up again, reload your workbook, go into the VBA Editor, and delete the enum you added. Then recompile and see if things work better for you.
You put an "Exit Sub" in the set offset, this is probably causing your problem.
I was able to fix the issue by making a new workbook and copying everything over. It worked fine. I think the original was corrupted somehow. For those having the same issue, I think Rich Holton's answer would be worth a try in case you have more than just a few things to copy. Thanks everyone for you time and input on this!
I am new to both VBA and stackoverflow. So please be patient ;).
I searched for a solution but could not find it.
My problem is as follows:
I have a column (A) with names and then a column (B) where some cells contain an "X" and others do not. I want to know which names have an "X" besides them.
Example:
I want now a string as a result, in one cell.
In this example:
Noah;Jacob;Elijah;Jayden
I got not very far.
For r = 1 To 20
If Cells(r, 2) = "X" Then A = Cells(r, 1) Else
Next
Then "A" is "Noah" and I can write it in a cell, but I want it to find all values and then write them combined, preferable seperated by ; in a cell.
Does anyone have any idea?
Create a string variable, then append your results to that variable based on "X" being in column B. Here's an example of how you could do it:
Sub Foo()
Dim i As Integer
Dim result As String
For i = 1 To 20
If UCase(Cells(i, 2).Value) = "X" Then
result = result & Cells(i, 1).Value & ";"
End If
Next
'// output the result to C1
Range("C1").Value = Left$(result, Len(result) - 1)
End Sub
Excel's native worksheet formulas do not handle concatenating an unknown number of strings together and compensating for the maximum number possible can get messy. A User Defined Function¹ (aka UDF) takes advantage of VBA's ability to process loops through a large number of rows while making numerical or string comparisons 'on-the-fly'.
build_List UDF
Function build_List(rNAMs As Range, rEXs As Range, vEX As Variant, _
Optional delim As String = ";", _
Optional bCS As Boolean = False)
Dim str As String, rw As Long, cl As Long
With rNAMs.Parent
Set rNAMs = Intersect(.UsedRange, rNAMs)
Set rEXs = .Cells(rEXs.Rows(1).Row, rEXs.Columns(1).Column). _
Resize(rNAMs.Rows.Count, rNAMs.Columns.Count)
End With
With rNAMs
For rw = .Rows(1).Row To .Rows(.Rows.Count).Row
For cl = .Columns(1).Row To .Columns(.Columns.Count).Row
If (.Cells(rw, cl).Offset(0, rEXs.Column + (cl - 1) - cl) = vEX And bCS) Or _
(LCase(.Cells(rw, cl).Offset(0, rEXs.Column + (cl - 1) - cl)) = LCase(vEX)) Then _
str = str & .Cells(rw, cl).Value & delim
Next cl
Next rw
End With
build_List = Left(str, Len(str) - Len(delim))
End Function
In D7 (as per image below) as,
=build_List(A:A, B:B, "x")
Applying the build_Lists UDf to your sample data
¹ A User Defined Function (aka UDF) is placed into a standard module code sheet. Tap Alt+F11 and when the VBE opens, immediately use the pull-down menus to Insert ► Module (Alt+I,M). Paste the function code into the new module code sheet titled something like Book1 - Module1 (Code). Tap Alt+Q to return to your worksheet(s).
Mate Juhasz answered the question very nice and simple, but now the answer dissapeared.
Mate wrote:
For r = 1 To 20
If Cells(r, 2) = "X" Then A = A & "; " & Cells(r, 1) Else
Next
And for me that solved it perfectly. Now "A" is a string as I wanted. Thank you so much!
I am using the following Index Match function to get the name of a company where the spend data matches that of which I type into cell BF17.
=INDEX($AM$16:$BB$16,MATCH(BF17,AM17:BB17,0))
What I want to be able to do is list multiple results within the same cell and separate these with a comma.
Does anyone know if this is possible and if so can someone please show me how?
Thanks
Code:
Insert this code in a module in your workbook:
Public Function hLookupList(KeyVal, Vals As Range, Ret As Range) As String
Dim i As Long
Dim vw As Worksheet
Dim rw As Worksheet
Dim RetStr As String
Application.Volatile True
Set vw = Vals.Worksheet
Set rw = Ret.Worksheet
If Vals.Rows.Count > 1 Then
hLookupList = "Too Many Value Rows Selected!"
Exit Function
End If
If Ret.Rows.Count > 1 Then
hLookupList = "Too Many Return Rows Selected!"
Exit Function
End If
If Vals.Columns.Count <> Ret.Columns.Count Then
hLookupList = "Value Range and Return Range must be the same size!"
Exit Function
End If
For i = Vals.Column To Vals.Column + Vals.Columns.Count - 1
If vw.Cells(Vals.Row, i) = KeyVal Then
RetStr = RetStr & rw.Cells(Ret.Row, Ret.Column + i - 1) & ", "
End If
Next i
hLookupList = Left(RetStr, Len(RetStr) - 2)
End Function
Then:
Insert this in the cell where you want your list: =hLookupList(BF17, $AM$16:$BB$16, $AM$17:$BB$17)
Unfortunately there is no built-in way to make a vlookup or index/match function return an array. You could do it with a custom formula or if you know there are a limited number of results, a few nested lookups. Lewiy at mrexcel.com wrote a great custom function that I use, which can be found here. This function can be slow if you are looking up a large number of rows.
Since you are looking up columns and want commas separating the results instead of spaces, you will need to modify the code as follows:
Function MYVLOOKUP(lookupval, lookuprange As Range, indexcol As Long)
Dim r As Range
Dim result As String
result = ""
For Each r In lookuprange
If r = lookupval Then
result = result & "," & r.offSet(indexcol, 0)
End If
Next r
result = Right(result, Len(result) - 1)
MYVLOOKUP = result
End Function
Your formula would then be =MYVLOOKUP(BF17,AM17:BB17,-1)
If you want a space after the comma (in the results), change:
result = result & "," & r.offSet(indexcol, 0)
to
result = result & ", " & r.offSet(indexcol, 0)
If you haven't used custom functions before, hit Alt + F11 when in Excel to bring up the VBE, and add a new module to the workbook you are working on (Insert --> Module). Just copy and paste this code in there. I would recommend Paste Special --> Values before sending the workbook to anyone. Let me know if you have any questions implementing it!