Macro to run through 3 conditions and provide value - vba

This is my first time using VBA for Excel (I usually code Java and C++), and I was hoping to get some tips to start out.
I want to write a macro for a large data set that will proceed through the following list of conditions to provide a dollar result:
Collect unit size from column A (Possible values 0-8)
Determine whether single or family unit from Column B (Single- 1, Family- 0)
Collect utility code from Column C (code for type of product being assessed)
From this information, a new value will be placed in the row which determines utility costs by taking into account unit size, type of unit, and the product in question. I have thought about using nested Select Case or nested conditionals in a loop, but overall I am pretty lost.

It seems like a worksheet formula might do the trick, but it's hard to tell without knowing what the calculation is. Below is a user-defined function (UDF) that you would put in a standard module. You would call it from a cell like:
=computecosts(A2,B2,C2)
Obviously the code would change depending on how your data is laid out and what your calculation is.
Public Function ComputeCosts(rSize As Range, rFamily As Range, rCode As Range) As Double
Dim lSizeFactor As Long
Dim lFamilyFactor As Long
Dim dCodeFactor As Double
Dim rFound As Range
Const lFAMILY As Long = 0
'Size factor is a function of 0-8, namely adding 1
lSizeFactor = rSize.Value + 1
'Family factor is computed in code
If rFamily.Value = lFAMILY Then
lFamilyFactor = 3
Else
lFamilyFactor = 2
End If
'Code factor is looked up in a different sheet
Set rFound = Worksheets("Sheet2").Columns(1).Cells.Find(rCode.Value, , xlValues, xlWhole)
If Not rFound Is Nothing Then
dCodeFactor = rFound.Offset(0, 1).Value
End If
'do the math
ComputeCosts = lSizeFactor * lFamilyFactor * dCodeFactor
End Function

Thanks for the responses, they were helpful in understanding VBA for Excel. I just ended up putting possible values in a table and then using Match functions within an Index function to pick out the right value.

Related

Finding and return values with associated rows on excel on multiple pages

Thanks in advance for any help! I haven't used much VBA in excel and can't work out how to do what I need, however I believe I need it to achieve the function I need within the workbook.
I have 31 data pages, in which I need to find if certain information is present and display it on a summary page.
I need is to check if there are values in the column AQ, If there is then I need the data returned in that row in columns E, F and G.
There could be multiple instances per sheet or none per sheet.
Hopefully this will example explain it better:
E F G ... AQ
Date Name Location Exception
2 1-12-17 Dave England
3 1-12-17 Sarah Wales Exp
In the example data above the information I would want returned on the Summary page is from row 3. (This type of data is on each of the 31 other pages)
Hope this makes sense! Any help on how to do this would be greatly appreciated.
There are a number of different ways you could tackle this problem, for example, pivot tables with specific filter conditions, a UDF that finds the matches and prints them to the output you'd like, etc. In general, it's not a bad idea to use the Range.Find method and loop through all the matches.
This requires a certain amount of programming time and energy, which not everyone has, although most people who use Excel a lot eventually end up using vLookup a lot. I've always been unsatisfied with vLookup, it's so limited compared to the vba Range.Find method. Just for you, since it's almost Christmas and I ran out of work that I'm actually paid to do, here's a little gem that should help solve your problem.
It's a UDF lookup that allows you specify which number match to return, and return a custom offset in rows or column to retrieve as a value. Incrementing the variable matchNum will give you all the matches in the range, and you can return whatever columns you want using the appropriate amount of offset.
The use of the Range.Find method should give you an idea of how you could use code to populate a worksheet with exactly what you wanted without using a UDF lookup function. I'll leave that as an exercise for the reader.
'################################################################################################################################
' findwhat: the value you want to find. (needle)
' where: the range you want to look for findwhat (haystack)
' matchNum: if the needle is found more than once in the haystack, find the nth target.
' rowoffset: offset your return value from the target, positive will return the value of the cell below the target.
' columoffset: offset your return value from the target, positive will return the value of the cell to the right of the target.
'################################################################################################################################
Public Function powerLookup(findwhat As Variant, where As Range, Optional matchNum As Long = 1, Optional rowOffset As Long = 0, Optional columnOffset As Long = 0) As Variant
Dim rngResult As Range, firstAddress As String
Set rngResult = Nothing
On Error GoTo Errorhandler ' if something breaks return #NA (will definitely happen if first find call fails)
Do While matchNum > 0 'loop through the matches until there are no matches or we've reached the target matchnumber
'the first time, rngResult will be Nothing, so the first find can't have rngResult as an input.
With where
If rngResult Is Nothing Then
Set rngResult = .find(findwhat, , xlValues)
firstAddress = rngResult.Address 'keep this to know if we've looped past the start
Else
'if rngResult is not nothing we've already found a match, find the next match until matchnum is 0
Set rngResult = .find(findwhat, rngResult, xlValues)
If rngResult.Address = firstAddress Then
'if we reach the first address we've looped around, no more matches found, throw #NA error
powerLookup = CVErr(xlErrNA)
Exit Function
End If
End If
End With
matchNum = matchNum - 1
Loop
powerLookup = rngResult.offset(rowOffset, columnOffset).Value 'offset the output
Exit Function
Errorhandler:
powerLookup = CVErr(xlErrNA)
End Function

VBA: Syntax for dynamic CountIf Ranges

I'll do my best to try and explain my problem, but it's still a bit fuzzy in my mind so this might not be as clear as it should be, for which I apologize in advance.
Here's the part of my code I'm having trouble with:
If Application.WorksheetFunction.countif(Range("D:D"), Cells(x, firstcolumn).Value) _
And Application.WorksheetFunction.countif(Range("F:F"), Cells(x, firstcolumn).Value) _
And Application.WorksheetFunction.countif(Range("H:H"), Cells(x, firstcolumn).Value) Then
The idea behind this project is to check if the values in "Cells(x, firstcolumn)" are present in columns D, F and H at the same time, and then paste the values somewhere else.
However the number of columns to check for the "Cells(x, firstcolumn)" values could be changed, so values would need to be checked in any number of columns (2, 10 etc). My code works perfectly for the specified Ranges but if one is missing or more are added then it stops working.
The columns to check against are always offset by 2 from the firstcolumn and firstcolumn is always B, it will be checked against D, F, H and so on while columns C,E,G etc have other data not relevant for this part.
My best guess is to have the countif Ranges changed dynamically but I'm at a loss of when and how this should be done...
Could anyone point me towards the right direction in order to achieve this? I can post the full code if needed.
Cheers!
You need to extract a function here. Something like this:
Private Function IsPresentInRange(ByVal source As Range, ByVal value As Variant) As Boolean
IsPresentInRange = Application.WorksheetFunction.CountIf(source, value) > 0
End Function
And then you need a way to figure out what ranges you need to give it for a source parameter - that can be a function of its own, or you can hard-code them somewhere; basically you want to have a concept of a group of ranges to call that function with - this would be the simplest:
Private Function GetSourceRanges() As Collection
Dim result As New Collection
result.Add Range("D:D")
result.Add Range("F:F")
result.Add Range("H:H")
'maintain this list here
Set GetSourceRanges = result
End Function
Ideally you would have some logic coded there, so that you don't need to manually add ranges to that collection every time.
And then you can just iterate these ranges and determine if you get a count > 0 for all of them:
Dim sources As Collection
Set sources = GetSourceRanges
Dim result As Boolean
result = True
Dim sourceRange As Range
For Each sourceRange In sources
result = result And IsPresentInRange(sourceRange, Cells(x, firstcolumn).Value)
Next
If result Then
' whatever you had in that If block
End If

#VALUE error with Excel VBA Function

In my Excel spreadsheet I have two columns.
A contains strings with the values 'Yes', 'No' or 'Maybe'.
B contains strings with a year in.
I need a function to determine the number of occurrences of a year in column B, where the equivalent value in column A is 'Yes'.
I currently have the following code:
Function CountIfYearAndValue(Rng As Range, YNM As String, Year As String) As Integer
Dim count As Integer
count = 0
For Each c In Rng.Cells
If (StrComp(Abs(c.Value), Year, vbTextCompare) = 0) And (StrComp(Cells(c.Row, A), YMN, vbTextCompare) = 0) Then count = count + 1
Next
CountIfYearAndValue = count
End Function
The idea of this code is that we iterate through every cell in the range given (a range on column B) and check if the year is equal to the Year parameter. And if the equivalent cell on column A is equal to the YNM parameter we increment the count variable.
For some reason this code does not work when I use the following parameter:
=CountIfYearAndValue('Years'!B1:B7,"Yes","Year 7")
It just does the #VALUE error and refuses to display any outcome.
Any help would be much appreciated.
Edit: All of the values in both cells are on of an unformatted datatype ('General') and no cells are blank.
It sounds like you are reinventing the wheel... There already is a built in function (advantage: being much faster than a UDF) that does exactly what you are after. It is called COUNTIFS()
All YESes for Year 7 in rows 1 to 10.
=COUNTIFS(B1:B10, "Year 7",A1:A10, "Yes")
I just had a quick look at your code and I think there are possibly a few reasons why your original code is not working as expected.
YNM is a valid column name therefore it should not be used as a variable name. You should avoid naming your variables like that - give it a more meaningful name
YNM != YMN as you had it in your code (see function definition and then the misspelled version in the StrComp() function)
Year is a valid VBA built in function, therefore once again you should avoid using it as a variable name as you're exposing yourself to a naming collision.
Add Option Explicit at the top of your module. This requires you to Dimension all you variables. It's always recommended for many many reasons.
rng variable is of Range type therefore you do not need to explicitly add the .Cells property to it. Even though it may help in some cases - at a bit more advanced level you may face some runtime type compatibility issues. ( runtime may convert your rng Range variable to a 2D array etc )
Added an explicit conversion in the second StrComp() function around the c.Offset(0, -1) as you don't want the runtime to (rare but still possible) convert your Yes to a Boolean data type. Explicit conversion to a String just gives you that extra protection ;p (lol)
therefore, something like this returns the correct value
Function CountIfYearAndValue(rng As Range, choice As String, myYear As String) As Long
Dim count As Long
count = 0
Dim c As Range
For Each c In rng
If (StrComp(c, myYear, vbTextCompare) = 0) And (StrComp(CStr(c.Offset(0, -1)), choice, vbTextCompare) = 0) Then
count = count + 1
End If
Next c
CountIfYearAndValue = count
End Function
Right, I hope this helps you understand bits and pieces :) any questions please leave a comment

Functions not actualizing

I execute a VBA code that takes a database, treats it and export it into a sheet. This is working fine. However, I have a sheet that produces graphs depending on the data in the particular sheet. The datas does not actualize. I have to enter the cell and click enter to actualize it. I'm pretty sure there is an easier way to do this. Calculation is set to automatic but that doesn't seem to change anything.
In my cell, I have my own vba function that needs to be updated once the report is done. When I click the cell and then enter, the result is updated but I would like this to be done automatically. I hope this is clearer !
Thanks in advance,
Etienne NOEL
HEre is the code of my function
Public Function number_of_appearances(term As String, sheet As String, column As Integer) As Integer
Application.Volatile
Dim number_of_rows As Integer
Dim appearances As Integer
Dim row As Integer
appearances = 0
row = 1
number_of_rows = Worksheets(sheet).UsedRange.Rows.Count
Do While row <= number_of_rows
If Worksheets(sheet).Cells(row, column).Value = term Then
appearances = appearances + 1
End If
row = row + 1
Loop
number_of_appearances = appearances
End Function
A cell example of a user of the function
=number_of_appearances('test';'sheet1'; 3)
Sounds like your UDF might not depend on any cells that change value when your DB is processed.
See This MSDN Link
Post your UDF (or just its header if you prefer) and an example of its use...
EDIT:
Yes, none of the parameters to the UDF are cell references, therefore the UDF is not triggered to recalculate when data on the shet changes.
You have two choices:
1. rewrite your UDF to include parameter(s) that reference cells that change value when the DB is processed
2. make your UDF volitile (include Application.Volatile in the UDF code) WARNING: this can be very inefficient, depending on how many time the UDF is used and how intensive its calculation is
EDIT 2:
Heres a refactor of your udf using the first option mentioned:
Public Function number_of_appearances(term As String, rng As Range) As Integer
Dim v As Variant
Dim i As Long, j As Long
Dim appearances As Long
v = Intersect(rng, rng.Worksheet.UsedRange)
For j = LBound(v, 2) To UBound(v, 2)
For i = LBound(v, 1) To UBound(v, 1)
If v(i, j) = term Then
appearances = appearances + 1
End If
Next i, j
number_of_appearances = appearances
End Function
use like
=number_of_appearances("test";Sheet1!C:C)
EDIT 3:
If all you are doing is counting number of occurances of a string in a range, consider using
=COUNTIF(Sheet1!C:C;"test")

Counting Rows/Columns of Selected Range Error

I am trying to determine if a selected range is within a set area... This toggles Copy/Paste restrictions in the spreadsheet. I have figured it out, I think, but I'm getting a run-time error 6 (Overflow) if you select an entire row or column. This is what I've got..
Function BETWEENROWS(ByVal Selected As Range, ByVal Min As Double, ByVal Max As Double) As Boolean
Dim LastRow As Integer
LastRow = Selected.Row + Selected.Rows.Count - 1
If BETWEEN(Min, Selected.Row, Max) = True And BETWEEN(Min, LastRow, Max) = True Then
BETWEENROWS = True
Else
BETWEENROWS = False
End If
End Function
There is one for columns BETWEENCOLUMNS as well and the function BETWEEN just returns True/False if a given number is between a min and max value.
This is working great, however, if an entire row/column is selected it's throwing an error and I'm not too familiar with VBA and the only way that I know of bypassing the error is with On Error Resume Next but that seems like I'm putting a bandaid on it and would like to figure out how to fix it another way.
Your LastRow variable is not the correct type for a number as large as the max columns/rows of the spreadsheet. Change the type to Long:
Dim LastRow As Long
You are getting an overflow error because you have made the LastRow variable an integer. Since there are more rows in an entire column then can fit in an integer variable, it triggers the overflow. You could fix this by changing the LastRow variable to be type Long
However, rather then comparing row values you may want to look into the Intersect() function. Given two (or more) ranges it will return the range object that represents the intersection of the two ranges. You could then check that intersection. If they don't intersect the range object will be Nothing. There is a good tutorial for this function at ozgrid.com
UPDATE
Here is the code to ensure range intersects fully using the Intersect() function
'// Run a test here to make sure Intersect does not return Nothing
If (TestRNG.Count <= ISectRNG.Count) And (Intersect(TestRNG, ISectRNG).Count = TestRNG.Count) Then
'// All of TestRNG falls within ISectRNG
End If