Range ID's changing due to cell selection - vba

32bit Excel 2013 / Win 7 64 bit
UDF asks user for two range inputs from the same table and a lookup value ie:
Public Function FindBfromA(A as Range,B as Range, IDValue as Integer)
For IDCheck = 1 to A.Count
IF A(IDCheck) = IDValue then
IDNum = IDCheck
Exit For
End if
Next IDCheck
FindBfromA = B(IDNum)
End Function
Formula is added into another column of the table, for example
=FindBfromA([A],[B],[#C])
'Where C is calculated via something
My issues is Ranges A & B become disjointed. Where A(IDCheck) and B(IDCheck) should belong to corresponding columns in the same table row, based on where my cursor is when calculating begins Range [B] will re-key
This then causes the formula to return the wrong value from the FindBfromA=B(IDNum) as A(IDNum){Row} <> B(IDNum){Row}
I couldn't reproduce the error in the workbook I created with the false data - in my company (private) workbook the function operates essentially the same way, but captures two 'B' values given two IDs and passes them to another function.

It's difficult to be sure without seeing your range selections, but the unreliable element of your code is the cell references. By using a single integer index, you are basically selecting the nth cell in the range rather than cell on row n. My suspicion is that range B is offset from range A by a number of rows. Let's say your two selections were A = "A1:A10" and B = "B2:B11" then A(3), for example, would be on row 3 but B(3) would be on row 4. The same would apply if Range A had more than one column.
To eliminate that risk, refer to the ranges by the row and column indexes, as in the code below. You'll note I've also change the data type of the IDValue to a variant as this prevent an error being thrown in your IDValue should ever be something like a String or Long. I've also looped through range A with a For Each loop on each cell to cater for the case that range A has more than one column.
Public Function FindBfromA(A As Range, B As Range, IDValue As Variant) As Variant
Dim cell As Range
For Each cell In A.Cells
If cell.Value2 = IDValue Then
FindBfromA = B.Cells(cell.Row, 1).Value2
Exit Function
End If
Next
End Function

Related

Derive cell value of an Excel Table based on two parameters

I have 2 columns in excel, A and B. In A I have percentages (rates) and in B integers numbers (years).
rating PD year
0.39% 3
0.88% 2
1.32% 17
0.88% 1
0.26% 15
0.17% 2
0.17% 2
0.59% 2
0.59% 2
Then I have a Table in which in column F I have years and in row I have text.
Like this (the table is much bigger and years go up to 30):
Rating
Year AAA AA+ AA AA-
1 0.003% 0.008% 0.018% 0.049%
2 0.016% 0.037% 0.074% 0.140%
3 0.041% 0.091% 0.172% 0.277%
4 0.085% 0.176% 0.318% 0.465%
5 0.150% 0.296% 0.514% 0.708%
And so on (the table is much bigger than this).
So I would need a function, or a shortcut, which, for a given rate in column A and a given year in column B, gives me, in column C, the corresponding rating (AAA,AA+,AA etc.).
In the table the rates are the maximum. So if I have A1=0.50% and B1=2, then I go to look at the table, year 2 and corresponding rate, which is 0.74% (and therefore AA), because AA+ is 0.37% and is too low.
In other words, AA+ and year 2 are all the rates between 0.16% and 0.37%. And AA with year 2 are all the rates between 0.37% and 0.74%.
Do you know how I could perform this task?
Thank you very much.
For the sake of code readability, I've used two custom-made functions, alongside the main procedure shown here. Otherwise it would be a huge code-dump.
Before you begin, you have to change/check these data fields.
The (blue) data table needs to be named "scores" (or changed inside code to your own name)
Same goes for the (green) grades table - to be named "grades" and start in F1
Last but not least, the code presumes these two tables are in a sheet called "Sheet1"
So all of this needs to be changed within the code, if the names do
not match!
Now to the procedure:
Option Explicit
Private Sub run_through_scores()
Dim scores As ListObject ' table from A1
Dim grades As ListObject ' table from F1
Set scores = Sheets("Sheet1").ListObjects("scores")
Set grades = Sheets("Sheet1").ListObjects("grades")
Dim cell As Range ' for "for" loop
Dim inrow As Long ' will store in which row the year is
Dim resultColumn As Integer ' will store in which column the percentage is
'for every cell in second column of scores table (except header)
For Each cell In scores.ListColumns(2).DataBodyRange
inrow = get_year(cell).Row - 1
' ^ returns Row where result was found, -1 to accoutn for header
'using our get_interval() function, _
determines in which column is the sought percentage
resultColumn = get_interval(cell.Offset(0, -1), inrow).Column
cell.Offset(0, 1) = Sheets("Sheet1").Cells(1, resultColumn)
'write result in Column C ^
Next cell
End Sub
And to the functions:
get_year()
returns a Range Object from the "grades" table, in which we found
the matching year from our "scores" table. If the desired year is not found, it returns the year closest to it (the last table row)
' Returns a Range (coordinates) for where to search in second table
Private Function get_year(ByVal year As Variant) As Range
Dim grades As ListObject ' table from F1
Set grades = Sheets("Sheet1").ListObjects("grades")
Dim testcell As Range
Set testcell = grades.ListColumns(1).DataBodyRange.Find(year, LookIn:=xlValues)
'if found
If Not testcell Is Nothing Then
Set get_year = testcell
Else
Dim tbl_last_row As Long 'if year not found, return last row
tbl_last_row = grades.ListColumns(1).DataBodyRange.Rows.Count
Set get_year = grades.ListColumns(1).Range(tbl_last_row)
End If
End Function
And the second function:
get_interval()
returns a Range Object from the "grades" table. It compares individual cell ranges and returns upon a) if the sought percent from "scores" is less or equal (<=) then current cell percent or b) if we went through all the cells, it returns the last cell
(because it must be higher, than the maximum of specified interval)
Private Function get_interval(ByVal what As Variant, ByVal inyear As Long) As Range
Dim grades As ListObject ' table from F1
Set grades = Sheets("Sheet1").ListObjects("grades")
Dim cell As Range
For Each cell In grades.ListRows(inyear).Range
'check for interval
If what <= cell And cell.Column <> 6 Then 'we don't want to check year column
Set get_interval = cell
Exit Function
End If
Next cell
' if we arrived here, at this stage the result will always be the last cell
Set get_interval = grades.ListRows(inyear).Range(, grades.ListColumns.Count)
End Function
Upon firing (invoking) the run_through_scores() procedure, we get the results as expected:
if you have any questions, please let me know :)

VBA search column heading in a sheet and return SUM in another sheet

I would like to get datas from sheet 1 to sheet 2 with reference to the column headings With VBA.
For example:(EXCEL file)
So if I want to find the sum of fun1 person A with criteria 1 the command have to go and find the heading “sum of fun 1” in sheet 1 and choose the datas that are only under criteria 1 and sum it up in sheet 2 cell D5. (By using column heading reference instead of cell reference. The table range is A2 : U80. thanks.
Public Sub Match()
ThisWorkbook.Sheets("Sheet1").Activate
Range("Sheet2!B3") = Application.Sum(Application.Index(Range("A:G"), 0, Application.Match("Crit1" & "Fun1personA", Range("A2:G2"), 0)))
End Sub
I have tried it codes but it failed. i know that i havnt include the Row reference for crit1 , but iam not sure how to apply that to the formula.
Can anyone help me with this ? Thanks in advance
You could do it with a formula.
I'll assume that the table in your example covers the range A1:E10.
First we'll need to find the correct column using a MATCH formula:
=MATCH("Fun2PersonA",$1:$1,0) - this will return 3 as Fun2PersonA is in column C.
Next we need to know how many rows are in the table. Assuming the criteria in column A has no blanks except cell A1 we can use COUNTA:
=COUNTA($A:$A)+1 - this will return 10.
The above two formula will be used a few times within the final result, so will probably be easier to use helper cells to store the results (I'll just call them ColumnRef and LastRowRef for readability rather than actual cell references).
Now to set a reference to the first cell and last cell in column C.
=INDEX($1:$1,,ColumnRef) will reference the header, while =INDEX($1:$1048576,RowRef,ColumnRef) will reference the last cell.
As these can be used as references and not just values =SUM(INDEX($1:$1,,ColumnRef):INDEX($1:$1048576,RowRef,ColumnRef)) will sum everything in that column. It's the same as writing =SUM(C1:C10).
But you want to use SUMIF, so we need to reference the criteria in column A as well.
=INDEX($A:$A,RowRef) will reference the last cell in column A, so $A$1:INDEX($A:$A,RowRef) will reference all values in column A.
Final Formula:
The final step is to stick it all together into your final formula:
=SUMIF($A$1:INDEX($A:$A,RowRef),"Crit1",INDEX($1:$1,,ColumnRef):INDEX($1:$1048576,RowRef,ColumnRef))
This is the same as writing =SUMIF($A$1:$A$10,"Crit1",$C$1:$C$10)
For a VBA solution:
Public Function SumCriteria(FunPerson As String, Criteria As String) As Double
Dim rTable As Range
Dim rCol As Range
Dim rCriteria As Range
Dim LastRow As Long
Dim LastCol As Long
'Update Sheet1 to the sheet name with your table.
With ThisWorkbook.Worksheets("Sheet1")
'You may have to change how to find the last row/column depending
'on any extra data on the sheet.
LastRow = .Cells(Rows.Count, 1).End(xlUp).Row
LastCol = .Cells(1, Columns.Count).End(xlToLeft).Column
Set rTable = .Range(.Cells(1, 1), .Cells(LastRow, LastCol))
'EDIT: You could set your table as below if it's a static size.
'Set rTable = .Range("A2:U80")
'The first statement finds the FunPerson heading
Set rCol = rTable.Rows(1).Find(What:=FunPerson, LookIn:=xlValues, LookAt:=xlWhole)
If Not rCol Is Nothing Then
SumCriteria = Application.WorksheetFunction.SumIf(rTable.Columns(1), Criteria, rTable.Columns(rCol.Column))
Else
SumCriteria = CVErr(xlErrValue)
End If
End With
End Function
This method looks at column A and row 1 to get the dimensions of the table and then uses SUMIF to count the figures.
You can use it as a worksheet formula: =SumCriteria("Fun1PersonA","Crit1")
or within VBA:
Public Sub Test()
Dim a As Double
a = SumCriteria("Fun1PersonA", "Crit1")
End Sub

Excel VBA Function Lookover - Cooccurrences of two values

I've been working on a user-defined function in VBA to find a certain count. For background, "raw" is a worksheet that refers a sheet that has genres in column B and an artist ID in column C. The sheet that I'm working in has combinations of two genres: first in column A, second in column B.
Anyway, the function that I'm trying to build should do the following:
Take two inputs as strings. Check the genre column in "raw" for matches with the first input. Then, take that ID and find a cell that matches the ID and the second input. If there is one found, add one to a running count. Whether or not it is found, move onto the next match. The function will return an integer that indicates the number of times the two genres had the same artist ID.
Now, my function is returning #VALUE.. no syntax errors, no compiling errors. Just the error in returning the value. I've looked it over, googled like crazy, and I just can't figure it out. I'm new to VBA, so maybe I'm just missing something really obvious or I've defined something wrong. Either way, I just need another set of eyes to look over it. Any suggestions for improvement are much appreciated, so thank in advance for your time and help!!
Here is the code. I know it isn't the prettiest, but it's short and the logic should make sense.
Public Function cocount(c1 As String, c2 As String) As Integer
Dim rng As Range
Dim rng2 As Range
Dim cell As Range
Dim cell1 As Range
Dim ID As Integer
Dim Count As Integer
rng = Worksheets("Raw").Range("B2:B183579")
rng2 = Worksheets("Raw").Range("C2:C183579")
Count = 0
For Each cell In rng
If cell.Value = c1 Then
ID = cell.Offset(0, 1).Value
For Each cell1 In rng2
If cell1.Value = ID And cell1.Offset(0, -1).Value = c2 Then
Count = Count + 1
End If
Next cell1
End If
Next cell
cocount = Count
End Function
EDIT: Thanks for viewing my question and being willing to help (And thanks Rdster for attempting a solution). I uploaded pictures of the raw data and the combination, although it won't let me embed the images. Raw Data Combination List
Anyway, I'll try and explain my problem again. In the combination list of genres, each row contains two genres. I want to find how many times those two genres share the same artist ID in the Raw Data sheet. There are 181,000+ combinations, and 183,000+ rows in the Raw Data. Thus, the function needs to be efficient--something that I'm not incredibly great at doing even in other languages.
This can be achieved using built-in several different Excel Worksheet functions.
Excel Formula using COUNTIFS
Define 2 dynamic named ranges that will resize themselves to fit the data. Gendre_2 is defined relative to Gendre_1 this ensures that the ranges are the same size.
Gendre_1 = OFFSET(Raw!$A$1,1,0,COUNTA(Raw!$A:$A)-1,1)
Gendre_2 = OFFSET(Raw!$A$1,1,1,COUNTA(Raw!$A:$A)-1,1)
Formula
=COUNTIFS(Gendre_1,A2,Gendre_2,B2)
Reference: ExcelJet - Excel COUNTIFS Function
COUNTIFS counts the number of cells in a range that match supplied criteria. Unlike the COUNTIF function, COUNTIFS can apply more than one set of criteria, with more than one range. Ranges and criteria are applied in pairs, and only the first pair is required. For each additional criteria, you must supply another range/criteria pairs. Up to 127 range/criteria pairs are allowed.
VBA
Public Function cocount(c1 As String, c2 As String) As Double
Dim rng As Range, rng2 As Range
With Worksheets("Raw")
Set rng = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
Set rng2 = rng.Offset(0, 1)
cocount = WorksheetFunction.CountIfs(rng, c1, rng2, c2)
End With
End Function
If I understand correctly, you are trying to count the number of times that c1 and c2 = B# and C# where # is the same row.
Public Function cocount(c1 As String, c2 As String) As Integer
Dim Count As Integer, iRow as Integer
Count = 0
For iRow = 2 to Sheets("Raw").Cells(Rows.Count, "B").End(xlUp).Row
If Cells(iRow, "B") = c1 And Cells(iRow,"C") = c2 Then
Count = Count + 1
End If
Next iRow
cocount = Count
End Function
Check the genre column in "raw" for
matches with the first input. Then, take that ID and find a cell that
matches the ID and the second input.
try this:
Public Function cocount(FirstKey$, SecondKey$, FirstRng As Range, SecondRng As Range) As Long
Dim FirstAccurance As Range, ID$
Set FirstAccurance = FirstRng.Find(FirstKey, , xlValues, xlWhole, xlByRows, xlNext, 0)
ID = Cells(FirstAccurance.Row, SecondRng.Column).Value2
cocount = WorksheetFunction.CountIfs(SecondRng, ID, FirstRng, SecondKey)
End Function
test:

Best way to return data from multiple columns into one row?

I have a sheet with just order numbers and another with order numbers and all of the data associated with those order numbers. I want to match the order numbers and transfer all of the available data into the other sheet. I've been trying to use loops and VLOOKUP but I'm having problems (plus I have 116 columns I want to transfer data from so my vlookup expression doesn't look very nice). Any advice would be appreciated!
this is what I have so far and I'm getting an object error.
I don't think it's the right way to go about it in general though.
Dim LookUpRange As Range
Dim row As Range
Set LookUpRange = Worksheets("batches").Range("B4:B1384")
Set row = Worksheets("batches").Range("C:DL")
For Each row In LookUpRange
row.Select
Selection.FormulaArray ="=VLOOKUP(RC[-1],OrderLvl!RC[-1]:R[1380]C[113],{2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37,38,39,40,41,42,43,44,45,46,47,48,49,50,51,52,53,54,55,56,57,58,59,60,61,62,63,64,65,67,68,69,70,71,72,73,74,75,76,77,78,79,80,81,82,83,84,85,86,87,88,89,90,91,92,93,94,95,96,97,98,99,100,101,102,103,104,105,106,207,108,109,110,111,112,113,114,115},FALSE)"
Next row
End Sub
Please consider this VBA script to resolve your inquiry:
Sub LookupOuput()
Dim OrderNumberColumn As Range
Set OrderNumberColumn = Worksheets("batches").Range("B2:B1384")
Dim LookUpRange As Range
Set LookUpRange = Worksheets("OrderLvl").Range("C:DL")
Dim cell As Range
Dim FindResult As Range
For Each cell In OrderNumberColumn
If Not cell.Value2 = Empty Then
Set FindResult = LookUpRange.Find(what:=cell.Value2)
If Not FindResult Is Nothing Then
cell.Range("A1:DJ1").Value2 = LookUpRange.Rows(FindResult.row).Value2
End If
End If
Next cell
End Sub
Basically searches for each Order Number in the first sheet on the second sheet. This outputs (if search term exists) the cell that that string is found which we later refer to its row number to output the whole row to the first sheet. Cheers,
A regular VLOOKUP may be able to give you what you need, if you use a small trick...
Insert a row above the data table, and put sequential numbers in
each cell of that row. (ie, A1 = 1, B1 = 2, C1 = 3, etc...)
Do the same thing on your blank table.
Assuming that your first order number is in cell A2, put the following formula into B2: =VLOOKUP($A2,[other sheet name]!$A$1:$DZ$5000,B$1,0)
Drag this formula across all 116 columns, then down all however many rows you've got.
You'll need to adjust the ranges, obviously, but make sure that your lookup array starts in column A. (or alternatively, that your numbers start in the same column as the first column in your array.) Adding the numbers along the top allows you to change what column of the array you're referencing, just by dragging the cell formula.

vb excel drag formula for variable number of rows

I have a excel sheet which I am populating using a VB program. The output sheet can have variable number of rows but has 6 columns (A:F). Now I want the column G to have hex2dec of all the rows in column A. Here's an example: Say column A has 400 rows (A1:A400) then I want G1:G400 to have values HEX2DEC(A1:A400). But this is just an example the rows can vary. I have this code so far:
Sub DataMod()
Dim i As Long, R3 As Long
R3 = 1
For i = 1 To sheet.UsedRange.Rows.Count
sheet.Cells(i, 7).Formula = "=HEX2DEC" & sheet.Cells(R3, 1)
R3 = R3 + 1
Next i
End Sub
But it's not working.
Review your HEX2DEC formula string
it doesn't include the necessary ()
the Cells() would return the value of the target cell, not its address (i.e. the result would be =HEX2DEC(1234) instead of =HEX2DEC(A1) - which may or may not be a problem
you could use variable i instead of R3, they both increment from the same starting point at the same increment
I recommend to use FormulaR1C1, you do not have variants there
Sub DataMod()
Dim C As Range
For Each C In ActiveSheet.UsedRange.Columns(1).Cells
C(1, 7).FormulaR1C1 = "=HEX2DEC(RC[-6])"
Next C
End Sub
The danger of UsedRange is that it might include any header rows, so you might want to get around this by selecting the input range manually before you fire your Sub() and work with the Selection object, e.g.
For Each C In Selection.Columns(1).Cells
Try This:
Sub DataMod()
' Get the number of rows used in Column A:
Dim NumRows as Long
NumRows = Range("A1").End(xlDown).Row
' Put the formulas in Column G all at once:
Range("G1:G" & NumRows).FormulaR1C1 = "=Hex2Dec(RC1)"
End Sub