Function to merge excel data referencing a count using VBA - excel

I'm trying to write a function that merges multiple rows of text in a column into a single cell based on a pre determined count. My goal is to generate a flexible function to aid in compiling / interperting large quantaties of data. The code I've written returns #NAME? and I cant figure out where the error is. My code is as follows:
Function vmrg(countref As Integer, datref As Integer) As String
If IsEmpty(ActiveCell.Offset(0, -countref)) Then % check if cell containing count is blank
vertmerge = "N/A" % if blank, state N/A
Else
Dim datlst(0 To ActiveCell.Offset(0, -countref).Value - 1) As String
Dim i As Integer
For i = 0 To ActiveCell.Offset(0, -countref).Value - 1
datlst(i) = ActiveCell.Offset(i, -datref).Text %fill array with data
End
vertmerge = datlst(0)
For i = 1 To ActiveCell.Offset(0, -countref).Value - 1 % merge array to a single string
vertmerge = vertmerge & ", " & datlst(i)
End
End
End Function
I have matlab and some C++ experience but this is the first time I've used VBA so my syntax is probably odd in some areas and wrong in others. Ideally I would like to reference the cells where the data and count info are stored, but for now I'm hoping to correct my syntax and set a jumping off point for further development of this function. Any reccomendations are appreciated.
Code Rev_1: I still have an output of #NAME? but I think I've corrected(?) some of the issues
Function vertmerge(countref As Range, datref As Integer) As String
If IsEmpty(countref) = True Then
vertmerge = "NA"
Else
Dim datlst(0 To countref.Value - 1) As String
Dim i As Integer
For i = 0 To countref.Value - 1
datlst(i) = countref.Offset(i, datref).Text
Next i
vertmerge = datlst(0)
For i = 1 To countref.Value - 1
vertmerge = vertmerge & ", " & datlst(i)
Next i
End
End Function

You are doing some dangerous things here!
First - you are referencing "ActiveCell" from inside a function; but you have NO IDEA what cell will be active when the function runs! Instead, pass the target cell as a parameter:
=vmrg("B6", 5, 6)
and change your function prototype to
Function vmrg(r as Range, countref as Integer, datref as Integer)
Now you can reference things relative to r with
r.Offset(1,2)
etc.
Next - you are never assigning anything to vmrg. In VBA, the way a function returns a value is with (in this case)
vmrg = 23
You are assigning things to a variable called vertmerge - but that is not the name of your function. At least add
vmrg = vertmerge
Just before returning. That might do it. Without a full sample of your spreadsheet I can't help you more.

Related

UDF recalculates when data is entered in other occurrence of the UDF

Summary: all the occurrences of a UDF recalculate when one of them has a source changed.
I have a fairly simple UDF (code below) that calculates the stableford score of a golf round based on a couple of variables. Now I find that the UDF seems to be semi-volatile, in that as soon as I enter data in the data entry range (HoleScores) ALL of my occurrences of the UDF recalculate, even on other sheets. But if I press F9 (or choose to recalculate) they do not recalculate.
The desired situation is that only the UDF for which the data is entered recalculates. Can anybody help me achieve that?
nb: the HoleScores range is only referenced by one single UDF. All occurrences of the UDF use unique entry ranges. I have tested the recalc with the VBA screen open and closed. I am using Excel 2016
Public Function WACRondeScore(PlayingHandicap, Pars As Range, _
StrokeIndexen As Range, HoleScores As Range, _
Afgelast As String) As Variant
On Error GoTo FuncFail
Dim Hole As Long
Dim StablefordPuntenRonde As Long
Dim StablefordPunten As Long
If PlayingHandicap = "" Then
WACRondeScore = ""
Exit Function
Else
PlayingHandicap = CLng(PlayingHandicap)
End If
' Afgelast
If Not Afgelast = "" Then
WACRondeScore = "A"
Exit Function
End If
If IsEmptyRange(HoleScores) Then
WACRondeScore = ""
Exit Function
End If
For Hole = 1 To 9
If IsInteger(HoleScores(1, Hole)) Then
StablefordPunten = (Pars(1, Hole) + 2 + Int(((PlayingHandicap * 2) - StrokeIndexen(1, Hole) + 18) / 18)) - HoleScores(1, Hole)
If StablefordPunten < 0 Then StablefordPunten = 0
StablefordPuntenRonde = StablefordPuntenRonde + StablefordPunten
End If
Next Hole
WACRondeScore = StablefordPuntenRonde
Debug.Print "wacRONDESCORE"
Exit Function
FuncFail:
WACRondeScore = CVErr(xlErrValue)
End Function
I think I have found the cause of the recalculation. One of the entry values (PlayingHandicap) seems to be culprit. Don't know why, as yet, but am searching for the bug

VBA function runs as a macro but gives error when called with function

I have an excel table called AnimeList, where I have listed all the anime I have finished watching along with their info. The table has the following headers:
Name, Main Genre, Genre2, Genre3, Rating, Seasons, Episodes, Mins/Episode, Status.
I have written some VBA code that can count the distinct genres from the 3 columns as well as the number of them present.
Function CountAndSortGenre()
Dim size As Integer: size = Range("AnimeList[Main Genre]").Rows.Count
ReDim genreExtract((size * 3) - 1) As String
Dim i As Integer: i = 0
Dim cell As Range
For Each cell In Range("AnimeList[Main Genre]")
genreExtract(i) = cell.Value
i = i + 1
Next
For Each cell In Range("AnimeList[Genre - 2]")
genreExtract(i) = cell.Value
i = i + 1
Next
For Each cell In Range("AnimeList[Genre - 3]")
genreExtract(i) = cell.Value
i = i + 1
Next
Dim distinctGenres As New Dictionary
Dim genre As Variant
For Each genre In genreExtract
If distinctGenres.exists(genre) Then
distinctGenres(genre) = distinctGenres(genre) + 1
Else
distinctGenres.Add genre, 1
End If
Next
size = distinctGenres.Count
Erase genreExtract
ReDim sortedGenres(size - 1, 1) As Variant
For i = 0 To distinctGenres.Count - 1
sortedGenres(i, 0) = distinctGenres.Keys(i)
sortedGenres(i, 1) = distinctGenres.Items(i)
Next i
distinctGenres.RemoveAll
QuickSort sortedGenres, 0, size - 1 'This is done in a separate function
End Function
At the end I have what I need, i.e. the sorted genre counts in my sortedGenre array.
But I need to output it to the excel sheet now which is proving to be rather difficult task.
I tried calling the function after adding return type "As Variant" in the declaration and adding the statement CountAndSortGenre = sortedGenres at the end like so:
=CountAndSortGenre()
but the array which is returned is not spilled across multiple cells. Instead only the first element of the array is displayed on the cell where I input the formula.
I tried using Ctrl+Shift+Enter which changed the formula to:
{=CountAndSortGenre()}
but that did not change the output. It was still the first element of the array
I tried putting it in the index formula like so:
INDEX(CountAndSortGenre(), 1, 2)
trying to at least get something other than the first value of the array but that still kept returning the first value only.
Afterwards I tried using a manual approach to push the values into the cells by removing the As Variant return type and the return value in the end and adding the following code:
For i = 0 To size - 1
Application.ActiveCell.Offset(i + 1, 1) = sortedGenres(i, 0)
Application.ActiveCell.Offset(i + 1, 2) = sortedGenres(i, 1)
Next i
This approach worked when I ran the code but when I tried using the function like:
= CountAndSortGenre()
Excel gave me circular reference warning and thus it did not work.
The reason I dont want to use the macro and want to use it as a function is that I want these values to get updated as I update my source table. I am not sure that using a function will be dynamic, but it is the best bet. But right now I just want this function to start working.
I used an Array List because I'm too lazy to go look for my QuickSort routine; and I only created a single dimension output for horizontal output.
I used the range as an argument for the function so it would update dynamically when a cell in the called range is changed.
If your range may change in size, I'd suggest using either a dynamic named range, or using a Table with structured references, either of which can auto adjust the size.
If you require a vertical output, you can either Transpose before setting the output of the function; or loop into a 2D array.
Option Explicit
Option Compare Text
Function CountAndSortGenre(rg As Range) As Variant()
Dim v As Variant, w As Variant
Dim distinctGenres As Object
v = rg
Set distinctGenres = CreateObject("System.Collections.ArrayList")
With distinctGenres
For Each w In v
If w <> "" Then
If Not .contains(w) Then .Add w
End If
Next w
.Sort
CountAndSortGenre = .toarray
End With
End Function

Print Up to 300 Strings of Arrays to PDF Based on a Calculated Value

I need to print a string of arrays dependent on a difference of two values on my input page to separate sheets within the same PDF but I have been running into a few issues.
Based on the difference of two cells, the function will determine which arrays to print.
There are two possible solutions I have thought of but have been unsuccessful attempting both.
Indirectly reference a string of arrays in a cell to print such as "abc,bcd,cde,def,efg..."
(As Shown Below) Use conditional if-then functions to invoke the array based on the difference in these two cells
Primary Goals
Print into a single PDF
Determine specific arrays to print depending on the difference in two values contained in a cell on my input page
Allow for PageSetup values (have this figured out)
I am using MSFT 365. I tried initially using an indirect array reference to a cell with a variable value string including the arrays to be included without success.
Next, I tried to hardcode for all 100 possible values for this difference but in that case, I am running into line limits and errors associated with using _ to continue the array function on another line.
If the difference value equals 3, it is shown as below. If the difference value equals 4, you would add another array line including "schedule05","report05","p&l05"
Option Explicit
Sub PrintTest()
'if a certain difference value, use
If (Worksheets("Inputs").Range("D7") - Worksheets("Inputs").Range("D6")) = "3" Then
Dim pageArray As Variant
'set array for given difference
pageArray = Array("schedule01", "report01", "p&l01", _
"schedule02", "report02", "p&l02", _
"schedule03", "report03", "p&l03", _
"schedule04", "report04", "p&l04")
Worksheets("data").Activate
Worksheets("data").PageSetup.CenterHorizontally = True
'page setup values
With ActiveSheet.PageSetup
.FitToPagesWide = 1
.FitToPagesTall = 1
.Orientation = xlLandscape
End With
'call array for print
Worksheets("data").Range("pageArray").PrintOut
Elseif
'Here is where I could put another similar function for a difference of 4
'......
Else
'Here is where I could put another similar function for a difference of x
End If
End Sub
I expected this would get me a PDF where each of these arrays is printed on a separate sheet and will print a selection of arrays based on the difference value.
To expand on my comment, it would look like this:
Dim lDiff As Long
Dim pageArray As Variant
Dim sFormat As String
Dim i As Long, j As Long
'if a certain difference value, use
lDiff = Worksheets("Inputs").Range("D7").Value - Worksheets("Inputs").Range("D6").Value
ReDim pageArray(1 To (lDiff + 1) * 3)
For i = 1 To UBound(pageArray, 1) Step 3
j = j + 1
If j < 100 Then sFormat = "00" Else sFormat = "000"
pageArray(i) = "schedule" & Format(j, sFormat)
pageArray(i + 1) = "report" & Format(j, sFormat)
pageArray(i + 2) = "p&l" & Format(j, sFormat)
MsgBox pageArray(i)
Next i

Excel VBA offset Copy Paste

Hope you're doing well. I'm going to preface this by saying I'm not a programmer and I'm sure the code I have started is riddled with more errors then what I think. Hopefully you can help :D.
I have an Excel sheet that gets generated from another program that comes out like this:
excel sheet
However, the size of this sheet can change with every new generation of this sheet from the other program. (ex, A can have 7 next time, and D could have 9) And the sheet as it is cannot be used easily to do the math required as I only need specific groups of information at a given time, in this example groups B and D only.
What I'm hoping to create is something that will take the sheet as its generated, and turn it into something that looks like this:
result sheet
This is the code I've written so far, but since I don't really know what I'm doing I keep running into numerous problems. Any help would be appreciated.
Option Explicit
Sub Numbers()
Dim matchesFound As Integer
Dim row As Integer
Dim c As Integer
Dim copyRow As Integer
Dim copyLocationColumn As Integer
Dim arr(2) As String
arr(0) = "1"
arr(1) = "2"
arr(2) = "3"
Function arrayContainsValue(array, varValue)
found = false
for each = 0 to array
if array(i) = varValue then
found = true
exit for
arrayContainsValue = found
End Function
row = 1
c = 1
copyLocationColumn = 1
copyRow = 1
matchesFound = 0
Do While matchesFound < 3
if arrayContainsValue(arr, ThisWorkbook.Sheets("Data").Cell(column,row))
matchesFound = matchesFound + 1
Do While ThisWorkbook.Sheets("Data").Cell(column, row)
ThisWorkbook.Sheets("postHere").Cell(copyLocationColumn, copyRow) = _
ThisWorkbook.Sheets("postHere").Cell(c + 1, row)
copyRow = copyRow+1
row = row + 1
Loop
End If
row = row + 1
Loop
End Sub
There are many logic errors to numerate in a comment, Excel highlights them automatically I'll do a summary explaining them:
1. Function can't be "in the middle" of the sub, finish the Sub (take the Function from the sub and paste until it says end sub.
2.array is a forbidden name, try with another variable name
3.For each =0 ? to array? what do you try to mean like that? For Each has to be element in something For each element in Array for example For and To are for something defined in numbers (for counter=1 to 15)
Function arrayContainsValue(***array***, varValue) '2nd problem
found = false
for each = 0 to array '3rd problem
if array(i) = varValue then
found = true
exit for
arrayContainsValue = found
End Function
....
4. you're missing a then at the end
if arrayContainsValue(arr, ThisWorkbook.Sheets("Data").Cell(column,row))
I don't get the coding logic on how relates to the problem stated (?)

Excel Index Match - List All Results

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!

Resources