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

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

Related

Fill cells based on other table

I'm trying to automate certain functions in an Excel file.
Here is my issue:
Table 1 contains a string is Column "Info", followed by two empty cells. For each of the rows in Table 1, I want to check if a value of Table 2, Column "Fruit" exists in column "Info" of Table 1. If so, I would like to fill in the "Color" and "Price" of Table 2 in the empty cells in Table 1.
For example, the second row contains the word "bananas", which means "Color" "Yellow" and "Price" "15" should be filled in the same columns in Table 1, row 2.
Somehow this issue seems so simple to me, but when I start to think of how to implement this, I get stuck. So unfortunately, I don't have any code available to fix. I just hope this issue isn't too vague.
I've also tried solving this issue using formulas, using MATCH and INDEX, but I couldn't get that to work either.
Here's a function that will return the row in the ListObject (Table) where the first matching word is found.
Public Function MatchFruit(ByVal sInfo As String, ByRef rFruit As Range) As Long
Dim vaSplit As Variant
Dim i As Long, j As Long
Dim rFound As Range
Dim sWhat As String
vaSplit = Split(sInfo, Space(1))
For i = LBound(vaSplit) To UBound(vaSplit)
'strip out non-alpha characters
sWhat = vbNullString
For j = 1 To Len(vaSplit(i))
If Asc(Mid(LCase(vaSplit(i)), j, 1)) >= 97 And Asc(Mid(LCase(vaSplit(i)), j, 1)) <= 122 Then
sWhat = sWhat & Mid(vaSplit(i), j, 1)
End If
Next j
'find the word in the range
Set rFound = Nothing
Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False)
If Not rFound Is Nothing Then 'if it's found
'return the row in the ListObject
MatchFruit = rFound.Row - rFruit.ListObject.HeaderRowRange.Row
'stop looking
Exit For
End If
Next i
End Function
Assuming your first table is called tblData and your second table tblFruit, you would get the color using
=INDEX(tblFruit[Color],MatchFruit([#Info],tblFruit[Fruit]))
and the price similarly
=INDEX(tblFruit[Price],MatchFruit([#Info],tblFruit[Fruit]))
Long Explanation
The vaSplit assignment line uses the Split function to convert a string into an array based on a delimiter. Since your sample data was sentences, the normal delimiter is a space to split it into words. A string like
This is some line about apples.
is converted to an array
vaSplit(1) This
vaSplit(2) is
vaSplit(3) some
vaSplit(4) line
vaSplit(5) about
vaSplit(6) apples.
Next, the For loop goes through every element in the array to see if it can find it in the other list. The functions LBound and Ubound (lower bound and upper bound) are used because we can't be sure how many elements the array will have.
The first operation inside the loop is to get rid of any extraneous characters. For that, we create the variable sWhat and set it to nothing. Then we loop through all the characters in the element to see if any are outside of the range a...z. Basically, anything that's a letter gets appended to sWhat and anything that's not (a number, a space, a period) doesn't. In the end sWhat is the same as the current element with all non-alpha characters stripped out. In this example, we'd never match apples. because of the period, so it's stripped away.
Once we have a good sWhat, we now use the Find method to see if that word exists in the rFruit range. If it does, then rFound will not be Nothing and we move ahead.
Note that if it doesn't find the word in the range, then rFound will be Nothing and the function will return zero.
If the word is found, the function returns the row it was found on less the row where the ListObject starts. That way the function returns what row it is withing the data of the ListObject not on the worksheet. This is useful when incorporating into an INDEX formula. To make a formula return something, you assign that something to the formula's name.
Finally, the Exit For line simply stops looking through the array once a match was found. If you have more than one match in your data, it will only return the first one.
Troubleshooting
The most likely error that you'll find is that the function will return zero when you expect it to return a row number. That most likely means it did not find any words in the list.
If you're certain that both lists contain a matching word, here's how you troubleshoot it: After the Set rFound = line put a Debug.Print statement.
Set rFound = rFruit.Find(sWhat, , xlValues, xlWhole, , , False)
Debug.Print "." & sWhat & "."
If Not rFound Is Nothing Then 'if it's found
That will print sWhat to the Immediate Window (Ctrl+G in the VBE to see the Immediate Window). The periods around the word are so you can see any non-printable characters (like spaces). If you try to match .pears . with pears it won't match because the first one has a space at the end - and you can see that because we stuck periods before and after.
If spaces are going to be a problem, you can use the Trim$() function on sWhat to get rid of them first.
With that Debug.Print statement, you might see results like
.paers.
in which case would recognize that you have a typo.
To Dick and other people who may be interested. Like I mentioned in my last comment on the answer provided by #Dick-Kusleika, his answer didn't fully cover my initial question. Even though it gave me great insight and it did the job of filling the empty cells with the appropriate data, I was really looking for something that would do it automatically, without me having to copy-paste any formulas. So I spent some more time trying to figure it out, getting info from the internet and sparring with a colleague who shares my interest in this. And eventually I managed to get it working! (hurray!!)
Below is my solution. As I'm still a beginner, I probably did a few things that could have been done better or cleaner. So I'm really interested in your opinion about this and would love to hear any remarks or tips.
Sub check_fruit()
Dim ws As Excel.Worksheet
Dim lo_Data As Excel.ListObject
Dim lo_Fruit As Excel.ListObject
Dim lr_Data As Excel.ListRow
Dim lr_Fruit As Excel.ListRow
Dim d_Info As Variant
Dim f_Fruit As Variant
Set ws = ThisWorkbook.Worksheets("Exercise")
Set lo_Data = ws.ListObjects("tblData")
Set lo_Fruit = ws.ListObjects("tblFruit")
For Each lr_Data In lo_Data.ListRows
'check if field "Color" is empty in tblData'
If IsEmpty(Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value) Then
d_Info = Intersect(lr_Data.Range, lo_Data.ListColumns("Info").Range).Value
For Each lr_Fruit In lo_Fruit.ListRows
f_Fruit = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Fruit").Range).Value
'check for each row in tblFruit if value for field "Fruit" exists in field "Info" of tblData'
If InStr(1, d_Info, f_Fruit, vbTextCompare) <> 0 Then
Intersect(lr_Data.Range, lo_Data.ListColumns("Color").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Color").Range).Value
Intersect(lr_Data.Range, lo_Data.ListColumns("Price").Range).Value = Intersect(lr_Fruit.Range, lo_Fruit.ListColumns("Price").Range).Value
End If
Next lr_Fruit
End If
Next lr_Data
End Sub

Finding cellindex depending on cell content in excel

Im in a bit of a hard spot at the moment, i've been searching the web for some weeks now whitout any luck. I hope some of you might have the answer however.
I want to search through a row for a cell with a specific numeric value. The row contains weeknumbers. When found i would like to be able to handle the cell like an object, or at least i need to know the coordiantes of the cell for further processing.
Furthermore, can that process be reversed. Meaning, can i get the value from say the next cell in the same row if i have the coordinates of the prior cell?
Example would be:
Search through row for the week number for this week.
Hopefully get the coordinates for the cell that contains the right number.
When i have that column, i want to find the content of the cells monday to friday for that week for every coworker
I doesnt matter if this i done by VBA or formulas.
Thanks a lot in advance.
Best regards Teambit
No need for VBA for this... you should be able to achieve it with formulae easily enough.
So, cell L3 has the formula:=ADDRESS(3,MATCH($B$1,$A$3:$N$3,0)). This will perform a MATCH on the week entered into cell $B$1 and find it in the range of weeks $A$3:$N$3. The ADDRESS function will return the cell address for where the week number is found, so $G$3 in my example.
Then the lower grid/table will display the working week for the current week. The OFFSET function is moving the cell address down 3 rows, then right 1, 2, 3, 4, or 6 rows for each day of the week. OFFSET will return a 0 for a blank, so the T function is ensuring we get a text equivalent, or blank instead of 0. I'm using INDIRECT to pass the OFFSET function the starting cell address, so it is using the value of our starting week cell ($G$3), instead of that cell ($L$1).
I've not put anything in to make this dynamic per worker, so it's always using row 3, but you can get a cell reference using ADDRESS from a VLOOKUP for a name and then plug that into the other formulae.
Check if this help u..
Sub SubOne()
Dim sh As Worksheet
Dim rw As Range
Dim iFoundIt As Range
Dim RowCount As Integer
' var to iterate trough rows
RowCount = 0
Set sh = ActiveSheet
For Each rw In sh.Rows
' iterate over all cells in first row
If sh.Cells(rw.Row, 1).Value = "ThisIsMySpecialValue" Then
' value is found, we save the cell for future options
Set iFoundIt = sh.Cells(rw.Row, 1)
Exit For
End If
RowCount = RowCount + 1
Next rw
Debug.Print (iFoundIt.Row)
Debug.Print (iFoundIt.Column)
End Sub
I know if i understand your question well, but if you have coordinates of cell and you wana e.g. next cell on left you can use something like this
Sub findWeek()
Dim targetSheet As Worksheet
Set targetSheet = Sheets("Sheet1")
Dim l As Long
Dim row As Long
row = 2
Dim myVal As String
myVal = "some name of week you looking for"
Dim resultCell As Range
With targetSheet
Do While .Cells(row, l).Value <> myVal
l = l + 1
Loop
resultCell = .Cells(row, l)
End With
End Sub
So i updated answer, try something like this. Just change sheet name, maybe row and even name which are you looking for. And in value resultCell you will have object of cell which you are looking for. And if you look at cell/range api you can get its coordinates etc...
So you can make it a function which will return range, or whatever you want... But always in value resultCell will be cell which you are looking for.
Maybe you will need to take care if week is not found ;) because this will stuck in loop, but its not that hard

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

Macro to run through 3 conditions and provide value

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.

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