How to loop though a table and access row items by their column header?
I have the following macro which needs to loop though an Excel-2007 table. The table has several columns and I am currently finding the correct column position using the Index
property columns.
Using the index is th开发者_高级运维e only way I could find to correctly index into the fName
object. The better option I am hoping for is to access specific columns using the Column Name/Header. How can I do this and can this be even done?
Furthermore, in general, is there a better way to construct this loop?
Worksheets("Lists").Select
Dim filesToImport As ListObject
Dim fName As Object
Dim fileNameWithDate As String
Dim newFileColIndex As Integer
Dim newSheetColIndex As Integer
Set filesToImport = ActiveSheet.ListObjects("tblSourceFiles")
newFileColIndex = filesToImport.ListColumns("New File Name").Index // <- Can this be different?
For Each fName In filesToImport.ListRows // Is there a better way?
If InStr(fName.Range(1, col), "DATE") <> 0 Then
// Need to change the ffg line to access by column name
fileNameWithDate = Replace(fName.Range(1, newFileColIndex).value, "DATE", _
Format(ThisWorkbook.names("ValDate").RefersToRange, "yyyymmdd"))
wbName = OpenCSVFIle(fPath & fileNameWithDate)
CopyData sourceFile:=CStr(fileNameWithDate), destFile:=destFile, destSheet:="temp"
End If
Next fName2
Foreword
I found this through google, and I found it lacking. So I'm going to fill in some more information, explain what's going on and also optimize the code a bit.
Explanation
The obvious answer that should have been brought to you is:
Yes, it can be done. In fact, it's simpler than you'd think.
I noticed you did this
newFileColIndex = filesToImport.ListColumns("New File Name").Index
Which gave you the index of the header "New File Name".
Then, when you decided to check for the columns, you forgot that the index is actually the relative column position as well.
So, instead of a column number you should've done the same thing as before
InStr(fName.Range(1, filesToImport.ListColumns("Column Name")), "DATE")
Let's dig a little deeper, and explain with not only words, but with pictures
In the picture above, the first row shows the absolute column index,
where A1 has a column index of 1, B1 has a column index of 2 and so on.
The ListObject
's headers have their own relative indexes,
where, in this example, Column1 would have column index 1, Column2 would have column index 2 and so on. This allows us to utilize the ListRow.Range
property when referencing the columns either with numbers or names.
To better demonstrate, here's a code that prints the relative and absolute column index of "Column1" from the previous image.
Public Sub Example()
Dim wsCurrent As Worksheet, _
loTable1 As ListObject, _
lcColumns As ListColumns
Set wsCurrent = ActiveSheet
Set loTable1 = wsCurrent.ListObjects("Table1")
Set lcColumns = loTable1.ListColumns
Debug.Print lcColumns("Column1").Index 'Relative. Prints 1
Debug.Print lcColumns("Column1").Range.Column 'Absolute. Prints 3
End Sub
Since the ListRow.Range
refers to the range, it becomes a matter of relativity because that range is inside the ListObject
.
So, for example, to reference Column2 in each iteration of
ListRow
you could do like this
Public Sub Example()
Dim wsCurrent As Worksheet, _
loTable1 As ListObject, _
lcColumns As ListColumns, _
lrCurrent As ListRow
Set wsCurrent = ActiveSheet
Set loTable1 = wsCurrent.ListObjects("Table1")
Set lcColumns = loTable1.ListColumns
For i = 1 To loTable1.ListRows.Count
Set lrCurrent = loTable1.ListRows(i)
'Using position: Range(1, 2)
Debug.Print lrCurrent.Range(1, 2)
'Using header name: Range(1, 2)
Debug.Print lrCurrent.Range(1, lcColumns("Column2").Index)
'Using global range column values: Range(1, (4-2))
Debug.Print lrCurrent.Range(1, (lcColumns("Column2").Range.Column - loTable1.Range.Column))
'Using pure global range values: Range(5,4)
Debug.Print wsCurrent.Cells(lrCurrent.Range.Row, lcColumns("Column2").Range.Column)
Next i
End If
Optimized Code
As promised, here's the optimized code.
Public Sub Code()
Dim wsCurrentSheet As Worksheet, _
loSourceFiles As ListObject, _
lcColumns As ListColumns, _
lrCurrent As ListRow, _
strFileNameDate As String
Set wsCurrentSheet = Worksheets("Lists")
Set loSourceFiles = wsCurrentSheet.ListObjects("tblSourceFiles")
Set lcColumns = loSourceFiles.ListColumns
For i = 1 To loSourceFiles.ListRows.Count
Set lrCurrent = loSourceFiles.ListRows(i)
If InStr(lrCurrent.Range(1, lcColumns("Column Name").Index), "DATE") <> 0 Then
strSrc = lrCurrent.Range(1, lcColumns("New File Name").Index).value
strReplace = Format(ThisWorkbook.Names("ValDate").RefersToRange, "yyyymmdd")
strFileNameDate = Replace(strSrc, "DATE", strReplace)
wbName = OpenCSVFile("Path" & strFileNameDate)
CopyData sourceFile:=CStr(strFileNameDate), _
destFile:="file", _
destSheet:="temp"
End If
Next i
End Sub
References
Personal experience.
MSDN
- ListObject
- ListColumns
- ListRows
This is a handy function:
Function rowCell(row As ListRow, col As String) As Range
Set rowCell = Intersect(row.Range, row.Parent.ListColumns(col).Range)
End Function
The most upvoted answer feels over complicated to me... This may not be the most optimal code, (you'd need a special class to make it both simple and optimal for this), but it will be faster than most solutions (probably including the most upvoted answer)
The following code will wrap a list object into a collection of collections:
'See: https://stackoverflow.com/questions/3070123/how-to-loop-though-a-table-and-access-row-items-by-their-column-header/52218247#52218247
Function loWrap(ByVal lo as listobject) as Collection
Set loWrap = New Collection
Dim lr As ListRow
For Each lr In lo.ListRows
loWrap.add lrWrap(lr, lo)
Next
End Function
Function lrWrap(lr As ListRow, lo as ListObject) As Collection
Dim vh As Variant: vh = lo.HeaderRowRange.Value 'Header
Dim vr As Variant: vr = lr.Range.Value 'This row
Dim retCol As New Collection
'Append list row and object to collection as __ListRow and __ListObject
retCol.Add lr, "__ListRow"
retCol.Add lo, "__ListObject"
'Loop through each header and append row value with header as key into return collection
For i = LBound(vh, 2) To UBound(vh, 2)
retCol.Add vr(1, i), vh(1, i)
Next
'Return retCol
Set lrWrap = retCol
End Function
Ultimately with the function you can do the following:
Dim MyListObject as ListObject: set MyListObject = Sheets("MySheet").ListObjects("MyTableName")
Dim row as Collection
For each row in loWrap(MyListObject)
debug.print row("My Table Header")
'If you need to access the list object you can do so via __ListObject
debug.print row("__ListObject").name
next
This makes your code a hell of a lot cleaner than any of the above in my opinion.
If you want to find a specific value in a column heading, you can use the find method. The find method returns a range, which you can then use as a reference to perform the rest of the operation. There are a lot of optional parameter to the find method, read up on it in the help docs if you need to tweak it more.
Dim cellsToSearch As Range
Dim foundColumn As Range
Dim searchValue As String
Set cellsToSearch = Sheet1.Range("A1:D1") ' Set your cells to be examined here
searchValue = "Whatever you're looking for goes here"
Set foundColumn = cellsToSearch.Find(What:=searchValue)
精彩评论