Once I have identified a cell of interest via a for loop, how can I then make a range out of the entire table row that contains said cell of interest?
I need help with only this small part of my larger code.
'TransColumn is a table column in which I am looking for the phrase "NPD".
'TransCell is my cell of interest, containing the phrase "NPD".
'I want Trans_Queue_Row to be the table row in which TransCell is located.
For Each TransCell In TransColumn
If InStr(1, TransCell.Value, "NPD") > 0 Then
Dim Trans_Queue_Row As Range
Set Trans_Queue_Row = ThisWorkbook.Sheets("Project Queue").ListObjects("TableQueue").ListRows
'I know this looks like a weird way to achieve what I'm asking for, but I'm using InStr to support some other elements of my code not displayed here.
I want a variable (i.e. - Trans_Queue_Row) to identify the entire table row that contains TransCell.
Dim TableQueue as ListObject, Trans_Queue_Row As Range, i as Long
Set TableQueue = ThisWorkbook.Sheets("Project Queue").ListObjects("TableQueue")
With TransColumn.DataBodyRange
For i = 1 To .Count
If InStr(1, .Rows(i).Value, "NPD") > 0 Then
Set Trans_Queue_Row = TableQueue.DataBodyRange.Rows(i)
End If
Next i
End With
From my answer to your previous question:
Trans_new_NPD_row.Range.Value = _
Application.Intersect(TransCell.EntireRow, QueueTable.DataBodyRange).Value
You can use Intersect to find the range common to TransCell.EntireRow and the data section of the table/listobject.
Related
Am trying to make a VBA validation sheet on Excel to find all the cells that do not match a predefined pattern and copy it to another sheet
My pattern is "4 numbers/5 numbers"
Ex: 1234/12345 is accepted
2062/67943 is accepted
372/13333 is not accepted
1234/1234 is not accepted etc...
I tried to put the following in the conditions sheet : <>****/***** and <>????/????? and both did not work (am not sure about the correctness of the approach as am still a beginner in VBA)
For the code itself, this is what I wrote :
Sub GuaranteeElig()
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = SheetName
Sheets("MainSheet").UsedRange.AdvancedFilter Action:= _
xlFilterCopy,
CriteriaRange:=Sheets("ConditionsSheet").Range("B1:B2"), _
CopyToRange:=Range("A1"), Unique:=False
End Sub
Any tips on how I can do it ?
Thanks in advance :)
As long as the values of the numbers are independent and do not matter, and it is only the Length of the numerical strings that count, you could use a for loop on the cells from the "search" sheet (I assume this is the MainSheet as shown in your code?) where your values are contained.
From there, I'll give you a couple ways to place the data in the validation sheet (assuming this is your ConditionsSheet as shown in your code?) where you are trying to pinpoint the values.
(You may need to change part of your approach depending on how you want the incorrect set of values laid out on your secondary sheet - but this should get you started.) I added a TON of comments as you say you're new to VBA - these will help you understand what is being done.
Sub GuaranteeElig()
'Adding this to help with performance:
Application.ScreenUpdating = False
'Assuming you are adding a sheet here to work with your found criteria.
Sheets.Add After:=ActiveSheet
ActiveSheet.Name = "ConditionsSheet"
'Using the naming bits below I am assuming the data you are searching for is on MainSheet
'Get used range (most accurate and efficient way I have found yet, others on S.O.
'may have better ways for this - research it if this does not work for you)
'I have had problems using the Sheets().UsedRange method.
Dim c as Long 'This may not be necessary for you if you are looping through only column "A"
Dim r as Long
'Cells(y,x) method uses numerical values for each row (y) or column (x).
c = Cells(1, Columns.Count).End(xlToLeft).Column 'May not be necessary depending on your needs.
'Using this because you have "UsedRange" in your
'code.
'.End(xlToLeft) signifies we are going to the end of the available cell range of
'Row 1 and then performing a "Ctrl+Left Arrow" to skip all blank cells until we hit
'the first non-blank cell.
r = Cells(Rows.Count, 1).End(xlUp).Row
'.End(xlUp) method is similar - we go to the end of the available cell range for the
'column ("A" in this case), then performing a "Ctrl+Up Arrow" to skip all blank cells.
'If you have a header row which spans across the sheet, this is your best option,
'unless you have 'helper' cells which extend beyond the final column of this header
'row. I am assuming Row 1 is a header in this case - change to your needs.
'For your Rows - choose the column which contains congruent data to the bottom of
'your used range - I will assume column 1 in this case - change to suit your needs.
Dim i as long
Dim j as integer
Dim cel as Range
Dim working_Str() as String 'String Array to use later
Dim string1 as String
Dim string2 as String
Dim badString as Boolean
For i = 2 to r Step 1 'Step down from row 2 to the end of data 1 Row at a time
'Row 1 is header.
set cel=Cells(i, 1) 'Sets the cell to check - assuming data is in Column "A"
'i will change from for loop so 'cel' changes from "A2555"
'to "A2554" to "A2553" etc.
working_Str=Split(cel.Value, "/", -1) 'Splits the value based on "/" inside of cel
string1=working_Str(0) 'what we hope will always be 4 digits
string2=working_Str(1) 'what we hope will always be 5 digits
If Len(string1)<>4 Then 'string1 _(xxxx)_(/)(don't care) does not equal 4 digits in length
badString = True
Elseif Len(string2)<>5 Then ''string1 (don't care)(/)_(xxxxx)_ does not equal 5 digits in length
badString = True
End If
If badString Then 'If either strings above were not correct length, then
'We will copy cell value over to the new sheet "ConditionsSheet"
'Comment the next 2 commands to change from going to one row at a time to
'Matching same row/Cell on the 2nd sheet. Change to suit your needs.
j = j + 1 'Counter to move through the cells as you go, only moving one cell
'at a time as you find incorrect values.
Sheets("ConditionsSheet").Range("A" & j).Value=cel.Value 'sets the value on other sheet
'UNComment the next command to change from going to one row at a time to
'matching same row/cell on the 2nd sheet. Change to suit your needs.
'Sheets("ConditionsSheet").Range("A" & i).Value=cel.Value
End if
badString = False 'resets your boolean so it will not fail next check if strings are correct
Next i
'Returning ScreenUpdating back to True to prevent Excel from suppressing screen updates
Application.ScreenUpdating = True
End Sub
UPDATE
Check the beginning and ending lines I just added into the subroutine. Application.ScreenUpdating will suppress or show the changes as they happen - suppressing them makes it go MUCH quicker. You also do not want to leave this setting disabled, as it will prevent Excel from showing updates as you try to work in the cell (like editing cell values, scrolling etc. . . Learned the hard way. . .)
Also, if you have a lot of records in the given row, you could try putting the data into an array first. There is a great example here at this StackOverflow Article.
Accessing the values of a range across multiple rows takes a LOT of bandwidth, so porting the range into an Array first will make this go much quicker, but it still may take a bit. Additionally, how you access the array information will be a little different, but it'll make sense as you research it a little more.
Alternative To VBA
If you want to try using a formula instead, you can use this - just modify for the range you are looking to search. This will potentially take longer depending on processing speed. I am entering the formula on 'Sheet2' and accessing 'Sheet1'
=IF(COUNTIF(Sheet1!A1,"????/?????"),1,0)
You are spot on with the search pattern you want to use, you just need to use a function which uses wildcard characters within an "if" function. What you do with the "If value is true" vs "If value is false" bits are up to you. COUNTIF will parse wildcards, so if it is able to "count" the cell matching this string combination, it will result in a "True" value for your if statement.
Regex method, this will dump the mismatched value in a worksheet named Result, change the input range and worksheet name accordingly.
In my testing, 72k cells in UsedRange takes about 4seconds~:
Option Explicit
Sub GuaranteeElig()
Const outputSheetName As String = "Result"
Dim testValues As Variant
testValues = ThisWorkbook.Worksheets("MainSheet").UsedRange.Value 'Input Range, change accordingly
Const numPattern As String = "[\d]{4}\/[\d]{5}"
Dim regex As Object
Set regex = CreateObject("VBScript.Regexp")
regex.Pattern = numPattern
Dim i As Long
Dim n As Long
Dim failValues As Collection
Set failValues = New Collection
'Loop through all the values and test if it fits the regex pattern - 4 digits + / + 5 digits
'Add the value to failValues collection if it fails the test.
For i = LBound(testValues, 1) To UBound(testValues, 1)
For n = LBound(testValues, 2) To UBound(testValues, 2)
If Not regex.Test(testValues(i, n)) Then failValues.Add testValues(i, n)
Next n
Next i
Erase testValues
Set regex = Nothing
If failValues.Count <> 0 Then
'If there are mismatched value(s) found
'Tranfer the values to an array for easy output later
Dim outputArr() As String
ReDim outputArr(1 To failValues.Count, 1 To 1) As String
For i = 1 To failValues.Count
outputArr(i, 1) = failValues(i)
Next i
'Test if output worksheet exist
Dim outputWS As Worksheet
On Error Resume Next
Set outputWS = ThisWorkbook.Worksheets(outputSheetName)
On Error GoTo 0
'If output worksheet doesn't exist, create a new sheet else clear the first column for array dump
If outputWS Is Nothing Then
Set outputWS = ThisWorkbook.Worksheets.Add
outputWS.Name = outputSheetName
Else
outputWS.Columns(1).Clear
End If
'Dump the array starting from cell A1
outputWS.Cells(1, 1).Resize(UBound(outputArr, 1)).Value = outputArr
Else
MsgBox "No mismatched value found in range"
End If
Set failValues = Nothing
End Sub
If you do not need duplicate values in the list of mismatched (i.e. unique values) then sound out in the comment.
Im pulling data from 2 tables, one works as i expected. but the other one, same code, wont work. I just dont get it. Everything seems to be identical.
I've isolated the "find" and they return the correct line numbers on both tables.
The problem is that the loCustomerTable doesnt seem to have anything in the .value
Debug.print does a line feed, thats it.
no errors generated.
Why? What am I missing?
Dim rProjectInfo As range
Dim rCustomerInfo As range
Dim loCustomerTable As ListObject
Dim loProjectTable As ListObject
Set loProjectTable = Worksheets("projektinformation").ListObjects("tblProjektinformation")
Set loCustomerTable = Worksheets("kundinfo").ListObjects("tblKundInformation")
sProjectNumber = "20-130"
' read project information
Set rProjectInfo = loProjectTable.range.rows((loProjectTable.range.Columns(1).Find(sProjectNumber).row))
' get customer info base off project info.
Set rCustomerInfo = loCustomerTable.range.rows((loCustomerTable.range.Columns(2).Find("gateau").row))
Debug.Print rProjectInfo.Cells(, 1).Value
Debug.Print rCustomerInfo.Cells(, 2).Value
I guess you are a victim of your monster statements (I don't get it why such statements are not split into smaller pieces so that you can easily debug it).
So let us split the statement
Set rCustomerInfo = _
loCustomerTable.range.rows((loCustomerTable.range.Columns(2).Find("gateau").row))
First thing you do is fetch the table column
dim tabCol as Range
set tabCol = loCustomerTable.range.Columns(2)
Debug.Print tabCol.Address
Check if the address is correct (should by). Now you search for your string ("gateau") in that column
dim rGateau as Range, row as long
set rGateau = tabCol.Find("gateau")
row = rGateau.Row
Debug.Print rGateau.Address, rGateau.Value2, row
That gives you the address of the cell with the search string (code assumes that this string can always be found), and its row number.
Now what you will see it that the row number is the row within the sheet, not within the table (listObject) - but you use it as row number within your table. If the table does not start at row 1, you are now reading data from the wrong row (which might even be below the table).
What you can do it either consider the start of your table or intersect the table with the row where you found the name.
' Variant 1: Calculate the row number within the table
row = rGateau.Row - loCustomerTable.Range.Row + 1
Set rCustomerInfo = loCustomerTable.Range.Rows(row)
' Variant 2: Intersect the (sheet) row with the table
row = rGateau.Row
Set rCustomerInfo = Intersect(loCustomerTable.Parent.Rows(row), loCustomerTable.Range)
Debug.Print rCustomerInfo.address
I have entered data into an Excel 2013 worksheet and converted it to a table (Table4) which has two columns "colour code" and "description". I want to read the table data from another workbook and loop through the table rows in VBA and where the value matches a value in the "description" column then I want to use the "colour code".
How do I loop through the table to do this?
At the moment I have tried a few ways but I am finding errors. The section of code currently looks like this:
Dim row As Range
For Each row In wb.Worksheets("Colour").ListObjects("Table4").ListRows
Debug.Print row.value
Next
Unless the table is only a single colum, you can't do a Debug.Print on the row.Value because the row will represent an array of values, and the debugger will raise an error if you try to print it.
Try something like this:
For Each row In wb.Worksheets("Colour").ListObjects("Table4").ListRows
For c = 1 to row.Columns.Count
Debug.Print row(1,c).Value
Next
Next
That method is cell-by-cell iteration which is probably what you need.
Alternatively, to simply print the entire row value:
For Each row In wb.Worksheets("Colour").ListObjects("Table4").ListRows
Debug.Print Join(Application.Transpose(row.Value), vbTab)
Next
But this doesn't give you as much freedom to manipulate cell values or anything like that.
Try looping over just the column you want to match. Once you find a match, you can look for the value in the correct column in the same row.
For Each cell in wb.Worksheets("Colour").Range("Table4[description]")
If cell.value = "Desired Value" then
Debug.Print(Cells(cell.row(), Range("Table4[colour code]").column))
End If
Next
The benefit to doing it this way is you can rearrange your table and your code will still work so long as those columns still exist with the same names.
I'd suggest using the following function:
Function lrWrap(lr As ListRow) As Collection
Dim lo As ListObject
set lo = lr.Parent
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 row as ListRow, rCol as Collection
For each row in Sheets("MySheet").ListObjects("MyTableName").ListRows
set rCol = lrWrap(row)
debug.print rCol("My Table Header")
'If you need to access the list object you can do so via __ListObject
debug.print rCol("__ListObject").name
next
This makes your code a lot cleaner than any of the above solutions, in my opinion.
I'm using macros to quickly search a large table of student data and consolidate it into a single cell for use in seating plans (I'm a teacher). Most of it works but I have a problem with selecting just the data I need.
Steps:
1. Remove data.
2. Run a formula to check if students fit into particular groups and consolidate their information
3. Format
Different subjects and year groups have different layouts for their data and so this step is causing me problems. I've tried using absolute cell references in step 2 but this doesn't work as sometimes the information that should be in column D is in column E etc.
What I want to be able to do is have a macro that checks the first value in the column (ie the title) and if it doesn't match one of a predetermined list delete the whole column along with it's data.
Dim rng As Range
For Each rng In Range("everything")
If rng.Value = "Test" Or rng.Value = "Test1" Then
rng.EntireColumn.Hidden = True
End If
I think I could use something like this if I could change the output from hiding columns to deleting them?
re: What I want to be able to do is have a macro that checks the first value in the column (ie the title) and if it doesn't match one of a predetermined list delete the whole column along with it's data.
To delete all columns NOT WITHIN the list:
Sub del_cols()
Dim c As Long, vCOL_LBLs As Variant
vCOL_LBLs = Array("BCD", "CDE", "DEF")
With Worksheets("Sheet7") '<~~ set this worksheet reference properly!
For c = .Cells(1, Columns.Count).End(xlToLeft).Column To 1 Step -1
If IsError(Application.Match(.Cells(1, c), vCOL_LBLs, 0)) Then
.Columns(c).Delete
End If
Next c
End With
End Sub
To delete all columns WITHIN the list:
Sub del_cols()
Dim v As Long, vCOL_LBLs As Variant
vCOL_LBLs = Array("BCD", "CDE", "DEF")
With Worksheets("Sheet7") '<~~ set this worksheet reference properly!
For v = LBound(vCOL_LBLs) To UBound(vCOL_LBLs)
Do While Not IsError(Application.Match(vCOL_LBLs(v), .Rows(1), 0))
.Cells(1, Application.Match(vCOL_LBLs(v), .Rows(1), 0)).EntireColumn.Delete
Loop
Next v
End With
End Sub
It seems that applying filter to a table has destroyed my understanding of how to handle this.
I have a table with multiple columns. I'm going to filter on one of the columns and sort on another. After that, I want to select/copy the first 10 rows of specific columns of what's filtered into another table.
I could easily do this before filters. I need the first 10 rows AFTER the filter is applied. I'm not seeing how to choose the 10th row AFTER a filter.
Can anyone point me to a VBA reference that explains how to do this? Do I need to use SQL to do this? Am I over thinking this and making it too complicated?
The following works to select the first 10 visible cells of column F, after filtering is applied. You'll need start at F2 if you want to exclude the header-cell.
Sub TenVisible()
Dim rng As Range
Dim rngF As Range
Dim rng10 As Range
Set rngF = Range("F:F").SpecialCells(xlCellTypeVisible)
For Each rng In Range("F:F")
If Not Intersect(rng, rngF) Is Nothing Then
If rng10 Is Nothing Then
Set rng10 = rng
Else
Set rng10 = Union(rng10, rng)
End If
If rng10.Cells.Count = 10 Then Exit For
End If
Next rng
Debug.Print rng10.Address
'.. $F$1:$F$2,$F$4:$F$5,$F$9:$F$10,$F$12,$F$20:$F$21,$F$23
rng10.Select
End Sub
The following is one of a number of ways to select from F2 downwards (assuming the UsedRange starts from row 1):
Set rngF = Range("F2", Cells(ActiveSheet.UsedRange.Rows.Count, _
Range("F2").Column)).SpecialCells(xlCellTypeVisible)
For what it's worth, seeing as this is one of the first search results for this kind of issue -
after filtering a table on a named column like this :
Worksheets("YourDataSheet").ListObjects("Table_Name").Range.AutoFilter _
field:=Worksheets("YourDataSheet").ListObjects("Table_Name").ListColumns("ColumnName").Index, _
Criteria1:="FilterFor..."
... I was then able to copy the resulting single visible row to another sheet using :
Worksheets("YourDataSheet").Range("Table_Name").SpecialCells(xlCellTypeVisible).Range("A1").EntireRow.Copy _
Destination:=Range("AnotherSheet!$A$2").EntireRow
So that's one way to refer to visible rows after the filtering. HTH.