I am trying to find a value in a named table (i.e. a listobject) but failing miserably.
I have a page containing a table of the same name as the page. So far I have 3 working lines to find the word "Area" in the description column and return the row number. This is:
Function CheckArea(ByVal My_Table As String)
Set Table = Worksheets(My_Table).ListObjects(My_Table)
Descriptions = Table.ListColumns("Description").Range
found_cell = Application.Match("Area", Descriptions, 0)
Once I have found the row, I want to access the information in the same row but a different column "Schem typ" and return the value contained. I cannot find how to access a cell within the table by a named column and a referenced row. If should be simple but I cannot find any examples out there. Can anyone help?
Table.ListColumns("Schem Typ").Range.Cells(found_Cell)
Try this
Dim MyTable As ListObject
Set MyTable = ThisWorkbook.ActiveSheet.ListObjects("Tabla_1")
Dim ZZ As Long
Dim MySearch As String
MySearch = "caca" 'change this whatever you want
On Error GoTo Errores:
ZZ = Application.WorksheetFunction.Match(MySearch, MyTable.ListColumns(1).Range, 0) - 1 'minus 1 to exclude header. Change 1 for number of column where you are searching
Debug.Print MyTable.DataBodyRange.Cells(ZZ, 2).Value 'Change 2 for number of column you want to obtain
Clear_All:
Set MyTable = Nothing
Exit Sub
Errores:
If Err.Number = 1004 Then
MsgBox MySearch & " not found"
GoTo Clear_All
Else
MsgBox Err.Description
End If
The code will use Match Function to find the value. IF not found, it will pop up a message (not the best error handling I must admit).
Try to adapt it to your needs.
Related
How can I grab a count of each unique value from a table's column, plus the actual value, into another cell.
Table 1's status column
**status**
------
itemA
itemA
itemB
itemC
desired results into a single cell:
Table 1 Status summary |2 itemA, 1 itemB, 1 itemC
I would settle for a simple comma separated list of all the distinct values without the count.
BACKGROUND INFO:
I have an excel document we are using to keep track of acceptance testing of a new application. The document which holds multiple worksheets (each representing an area of code that needs to be tested) and each worksheet has multiple tables (which represent test cases where each case should be tested multiple times or in different ways etc.) and then there is a summary worksheet where I want a snap shot of the data. On the summary page there is line for each table in each worksheet and a status column. In that status column I want to display a count of each status selected in the corresponding table. I had originally created a lengthy formula that hard coded the values and their counts if count was > 0, but as we are testing we are finding the need to add new status values and the formula then becomes way to burdensome to keep updated.
EDIT: ADDING FORMULA
Here is the formula that I originally had in there
=IF(COUNTIF(Table1[Status],"itemA"),COUNTIF(Table1[Status],"itemA")&" itemA"," ") & IF(COUNTIF(Table1[Status],"itemB"), ", " &COUNTIF(Table1[Status],"itemB")&" itemB"," ") & IF(COUNTIF(Table1[Status],"itemC"), ", " &COUNTIF(Table1[Status],"itemC")&" itemC"," ")
The problem with this is, the formula was repeated about 100 times on the summary page (once for each table in the underlying worksheets) and every time I wanted to add a status I would need to edit each of the formulas.
If your cells are in A1:A4, put this array formula in cells B1:B4:
{=$A$1:$A$4&": "&COUNTIF($A$1:$A$4,$A$1:$A$4)}
This will create your strings which look like itemA: 2 and itemB: 1, but there will be repetitions.
Then, you'd use the VBA code you suggested in the comments. I'm putting it here for the sake of completeness:
Function ConcatUniq(ByRef rng As Range) As String
Dim r As Range
Static dic As Object
If dic Is Nothing Then Set dic = CreateObject("Scripting.Dictionary")
For Each r In rng
If r.Value <> Empty Then
dic(r.Value) = Empty
End If
Next
ConcatUniq = Join$(dic.keys, ", ")
dic.RemoveAll
End Function
So your final string's cell formula will look like this:
=ConcatUniq(B1:B4)
This VBA solution uses an User Defined Function which:
.- Validates the Target Range belongs to a ListObject (Excel Table).
.- Uses an Array to hold all Status values from the table.
.- Uses a Control string to validate uniqueness Status.
.- Uses an Output string to hold the list of unique Status with the corresponding count.
Note: The list will have the same order as they appear in the table. Sort is not on the scope of the question but if you want it sorted I suggest to sort the ListObject as required (not included).
Try this procedure (see comments included in the code):
Private Function Lob_Status_Count(rTrg As Range) As String
Const kStt As String = "Status"
Dim lob As ListObject
Dim sControl As String, sOutput As String
Dim aStt As Variant, vStt As Variant, bStt As Byte
Rem Validate Input
On Error Resume Next
Set lob = rTrg.ListObject 'Set ListObject
On Error GoTo 0
If lob Is Nothing Then GoTo ExitTkn 'Exit if Target range is not a ListObject
With lob.ListColumns(kStt).DataBodyRange
Rem Set Status Array
aStt = WorksheetFunction.Transpose(.Value2)
Rem Set Status Output
For Each vStt In aStt
If InStr(sControl, Chr(167) & vStt & Chr(167)) = 0 Then 'Validates uniqueness
bStt = WorksheetFunction.CountIf(.Cells, vStt) 'Gets Status Count
sOutput = sOutput & ", " & bStt & " " & vStt 'Adds to Results
sControl = sControl & Chr(167) & vStt & Chr(167) 'Adds to Control
End If: Next
Rem Cleanup Output
sOutput = Replace(sOutput, ", ", vbNullString, 1, 1)
End With
Rem Set Results
Lob_Status_Count = sOutput
Exit Function
ExitTkn:
Lob_Status_Count = "!Err ListObject"
End Function
Suggest to read the following pages to gain a deeper understanding of the resources used:
Using Arrays,
ListObject Members (Excel),
WorksheetFunction Object (Excel),
For Each...Next Statement, InStr Function,
On Error Statement.
I'm working on problem that necessitates the use of nested formulas in excel. For eg:
I have a column for errors and one for its analysis
Error Analysis
Enter a valid material number Invalid Material
Eg errors:
Enter a valid material number; The material number 1234 does not
exist.
PO number XYZ does not exist.
VIN number 123 does not exist.
Country of origin AB does not exist.
I have a compendium of such errors and their analyis in the next sheet, and I'm using VLOOKUP in conjuction with FIND to lookup the analysis for the known errors.
=VLOOKUP(LEFT(F2, FIND(" ", F2, FIND(" ", F2) + 1) - 1)&"*", 'Sheet2'!A:B, 2, 0)
What i'm trying to do here is extract the first two words from the error and append a * to it and use it in VLOOKUP.
It would be something like Vlookup "PO number *" in the other sheet and get the analysis for it. Asterisk is because I don 't get the same number daily. And I also know that the extracted first two words of the error will be unique. (I know that error with "Enter a" as the first two words will not appear again).
Now I get errors in the same column so I thought of making a button and writing a code which uses the above formula.
I tried to modify some code off the net, but I'm not getting anywhere with it. I'm totally new to VBA. It'd be great if you can provide a snippet for this. I'll try to replicate the procedure for other needs.
This code seems to be working for now
Sub PopulateAnalysis()
Dim an_row As Long
Dim an_clm As Long
Dim lft As String
Dim st_num As Integer
Dim fin As String
Dim searchStr As String
Dim soughtStr As String
Table1 = Sheet1.Range("F2:F6") 'ErrorColumn from Error table (How do I make the range dynamic??)
Table2 = Sheet5.Range("A1:B6")
an_row = Sheet1.Range("G2").Row ' Populate this column from the analysis table on sheet2
an_clm = Sheet1.Range("G2").Column
For Each cl In Table1
'How do I translate the above formula into VBA statements??
st_num = InStr(InStr(cl, " ") + 1, cl, " ")
lft = left(cl, st_num - 1)
fin = lft & "*"
Sheet1.Cells(an_row, an_clm) = Application.WorksheetFunction.VLookup(fin, Table2, 2, True)
an_row = an_row + 1
Next cl
MsgBox "Done"
End Sub
This should work. You don't need the debug lines of course ;)
Sub PopulateAnalysis()
Dim rngTableWithErrors As Range
Dim rngTableWithAnalysis As Range
Application.ScreenUpdating = False
'set the range for Table with error, Table1 on sheet 1
With Sheets(1) 'change to name of the sheet, more reliable than index num.
Set rngTableWithErrors = .Range("F2:F" & .Cells(.Rows.Count, 6).End(xlUp).Row)
Debug.Print rngTableWithErrors.Address
End With
'set the range for Table with Analysis, Table 2 on sheet 2
With Sheets(2) 'change to name of the sheet, more reliable than index num.
Set rngTableWithAnalysis = .Range("A1:B" & .Cells(.Rows.Count, 2).End(xlUp).Row)
Debug.Print rngTableWithAnalysis.Address
End With
'formula for cell G2
'=VLOOKUP(LEFT(F2;FIND(" ";F2;FIND(" ";F2)+1)- 1)&"*";Sheet2!A1:B23;2; 0)
rngTableWithErrors.Offset(0, 1).FormulaR1C1 = _
"=VLOOKUP(LEFT(R[0]C[-1],FIND("" "",R[0]C[-1],FIND("" "",R[0]C[-1])+1)-1)& ""*"",Sheet2!R1C1:R" & rngTableWithAnalysis.Rows.Count & "C2,2, 0)"
Application.ScreenUpdating = True
MsgBox "Done"
End Sub
Notes
You can notice, that we are setting the upper left cells of ranges manually. It's better practice to somehow find the upper left cells (using Find method is my favorite) and work from there. You never know, how the user will change the worksheet - i.e. add new rows, columns etc.
I have a problem. I spent hours designing a form which works just great with all your feedback. Today, everything went wrong. The reason for this is simple. A few new columns got added and, obviously, the data my form is reading in is now wrong.
Thus I was thinking of trying the following...
Rather than using the column number as below
TK = Cells(ActiveCell.Row, "S").Value 'everything in the form refers to the active row
I could possibly use the column headings in Row 1.
Is that possible ? This way the spreadsheet can have columns added up to as many as a user would like and the form would dynamically scan for the right heading and get the column number that way.
My thought is, on opening the form, read in all the headings, pick out the ones I need and assign them to a variable. Then I use my normal code and substitute the variable into the column section.
It sounds easy, but I have no idea how to do this.
Use the versatile Find to give you a quick method of detecting where your header is - or if it is missing
Find details here
In the code below I have specified that the search must return
an exact match (xlWhole)
a case sensitive match (False)
The match can be a partial match (xlPart) if you were looking to match say Game out of Game X
code
Const strFind = "Game"
Sub GetEm()
Dim rng1 As Range
Set rng1 = ActiveSheet.Rows(1).Find(strFind, , xlValues, xlWhole, , , False)
If Not rng1 Is Nothing Then
MsgBox "Your column is " & rng1.Column
Else
MsgBox strFind & " not found", vbCritical
End If
End Sub
Why use a loop? There's no need to.
Dim col as variant
Col = application.match("my header", rows(1), 0)
If iserror(col) then
'not found
Else
TK = cells(activecell.row, col)
End if
For this purpose I usually use a function which runs through the headers (in the first row of a sheet) and returns the number of the column which contains the value I have searched for.
Public Function FindColumn(HeaderName As String, Sht As String) As Long
Dim ColFound As Boolean
Dim StartingPoint As Range
ColFound = False
Set StartingPoint = Sheets(Sht).Range("A1")
Do While StartingPoint.Value <> ""
If UCase(Trim(StartingPoint.Value)) = UCase(Trim(HeaderName)) Then
FindColumn = StartingPoint.Column
ColFound = True
Exit Do
Else
Set StartingPoint = StartingPoint.Offset(0, 1)
End If
Loop
If Not ColFound Then FindColumn = 0
End Function
Example:
If the first row of your sheet named "Timeline" contains headers like e.g. "Date" (A1), "Time" (B1), "Value" (C1) then calling FindColumn("Time", "Timeline") returns 2, since "Time" is the second column in sheet "Timeline"
Hope this may help you a little.
Your thought is a good one. Reading in column headers to calculate addresses is one way to avoid hard coding - e.g.
Sub Test()
Dim R As Range
Set R = ActiveSheet.[A1]
Debug.Print ColNo(R, "Col1Hdr")
End Sub
Function ColNo(HdrRange As Range, ColName As String) As Integer
' 1st column with empty header is returned if string not found
ColNo = 1
Do While HdrRange(1, ColNo) <> ""
If HdrRange(1, ColNo) = ColName Then Exit Do
ColNo = ColNo + 1
Loop
End Function
Another way I frequently use - and I must admit I prefer it over the above, is to define Enum's for all my tables in a seperate "definition" module, e.g.
Public Enum T_VPN ' sheet VPN
NofHRows = 3 ' number of header rows
NofCols = 35 ' number of columns
MaxData = 203 ' last row validated
GroupNo = 1
CtyCode = 2
Country = 3
MRegion = 4
PRegion = 5
City = 6
SiteType = 7
' ....
End Enum
and use it like
Sub Test1()
Debug.Print ActiveSheet(T_VPN.NofHRows, T_VPN.Country)
End Sub
As you can see, the usage is simpler. Allthough this is again "some kind" of hardcoding, having all definition in one place reduces maintenance significantly.
I am writing a small score lookup program in VBA and the following code gives the error in the title, i'm new to VBA and the error points to the first line which was generated by Excel itself.
Private Sub btnSearch_Click()
Name = txtSearch.Text
AmountOfEntries = Range("i10")
For i = 1 To AmountOfEntries
If Range("a" + i) = Name Then
cell = i
Else
cell = "Error"
End If
Next i
If cell = "Error" Then
lblScore.Caption = "Your Username is Incorrect. Please Try Again"
Else
lblScore.Caption = "Your Score Is : " + Range("b" + cell)
End If
End Sub
My spreadsheet contains a list of names in the 'A' column then a list of scores in the 'B' column. in 'I10' there is a field containing the amount of entries in the list.
You should try to avoid using "name", "cell" etc (generic terms in VBA) as variable names. Try defining your variables Dim strName as String, i as Integer, intCell as Integer, intAmountOfEntries as Integer.
Also, your range statements should be changed to use & and to specify that you want to use the VALUE not the RANGE aspect of the object:
Range("a" & i).Value and Range("b" & intCell).Value
EDIT =============
Re your comments below:
I think the issue is due to you using cell as an integer (the row number) and also a string ("error"). I would create a new variable to detect if there is an error or not:
Dim blnError as Boolean
Then replace this:
cell = "Error" with blnError = True
Your If statement below will need to be amended to If blnError = True Then
Can you confirm that you have a Sheet called "Sheet1"? If not, then that is why the Sheets("Sheet1") code doesn't work. I normally use the VBA names for sheets instead - in the VBE you can see what they are in the project explorer (name before the brackets) and you can change them using the properties window. Then you just use sheetname.Range("A1").
I want to update the contents of a cell in a workbook. My code looks a little like this:
ProductionWorkBook.Sheets("Production Schedule").Cells(StartRow, 1).Value = EstJobName(i)
The cells are referenced using Cells(StartRow, 1) Where StartRow was a pre-declared and pre-defined integer variable that specifies the row and "1" denotes the column.
EDIT:
Now, I want to change this code to reference the columns by the column HEADERS instead.
For example, the header of a column is: "Fab Hours Date", how do I reference that?
Yes, you can simply use the letter name for the column in quotes:
Cells(StartRow, "A")
Edited to answer your further question:
to look for a specific column name, try this:
columnNamesRow = 1 ' or whichever row your names are in
nameToSearch = "Fab Hours" ' or whatever name you want to search for
columnToUse = 0
lastUsedColumn = Worksheets("Foo").Cells(1, Worksheets("Foo").Columns.Count).End(xlToLeft).Column
For col = 1 To lastUsedColumn
If Worksheets("Foo").Cells(columnNamesRow, col).Value = nameToSearch Then
columnToUse = col
End If
Next col
If columnToUse > 0 Then
' found the column you wanted, do your thing here using "columnToUse" as the column index
End If
Here are two different functions to get what you want. To use them, you'd have to put them in your code.
Function ColumnNumberByHeader(text As String, Optional headerRange As Range) As Long
Dim foundRange As Range
If (headerRange Is Nothing) Then
Set headerRange = Range("1:1")
End If
Set foundRange = headerRange.Find(text)
If (foundRange Is Nothing) Then
MsgBox "Could not find column that matches header: " & text, vbCritical, "Header Not Found"
ColumnNumberByHeader = 0
Else
ColumnNumberByHeader = foundRange.Column
End If
End Function
Function ColumnNumberByHeader2(text As String, Optional headerRange As Range) As Long
If (headerRange Is Nothing) Then
Set headerRange = Range("1:1")
End If
On Error Resume Next
ColumnNumberByHeader2 = WorksheetFunction.Match(text, headerRange, False)
If Err.Number <> 0 Then
MsgBox "Could not find column that matches header: " & text, vbCritical, "Header Not Found"
ColumnNumberByHeader2 = 0
End If
On Error GoTo 0
End Function
Example Calls:
ColumnNumberByHeader ("Extn")
ColumnNumberByHeader("1718", Range("2:2"))
Or in your case:
ProductionWorkBook.Sheets("Production Schedule"). _
Cells(StartRow, ColumnNumberByHeader("Fab Hours Date")).Value = EstJobName(i)
ProductionWorkBook.Sheets("Production Schedule").Range("A" & StartRow).Value = EstJobName(i)
Unless you mean the column is a named range you defined?
ProductionWorkBook.Sheets("Production Schedule").Range("E"& StartRow).Value = ...
will do the job.
Though keep in mind that using hard coded references like the column letter will risk that the macro breaks when the sheet is edited (e.g. a column is inserted). It's therefore better to use a named range and Offset to access:
ProductionWorkBook.Sheets("Production Schedule").Range("StartCell").Offset(StartRow-1).Value
Now you only need to provide the name StartCellto your fist cell (make sure that it's a local name in the Name Manager)