I need to check if the current cell in the table is on the first row. It must check inside the it's own table, not just the sheet. I couldn't find any info on this. Is this possible using a formula? I want to do a special operation if this is the case.
Using native worksheet functions to construct a simple formula, you can retrieve the relative row position within the ListObject (aka structured) table by subtracting the header row.
=ROW()-ROW(Table1[#Headers])
The result could be compared to 1 to return a boolean result determining if you are in the first row of the table.
Consider:
Sub WhereIsTheActiveCell()
Dim EquivRange As Range, r As Range
Dim lo As ListObject
Dim nFirstRow As Long, nLastRow As Long
Set lo = ActiveSheet.ListObjects(1)
With lo
Set EquivRange = .DataBodyRange
nFirstRow = EquivRange.Row
nLastRow = EquivRange.Rows.Count + EquivRange.Row - 1
If ActiveCell.Row = nFirstRow Then
MsgBox "activecell is in the first data row of the table"
ElseIf ActiveCell.Row = nFirstRow - 1 Then
MsgBox "activecell is the the header row of the table"
End If
End With
End Sub
Related
I have data organized into rows and in column B I have data titles. I want to select the data after the titles and then give them range names based on that title. I was able to code a solution that could name column ranges dynamically this way, but when altering it to name the rows of data I run into a 1004 error, specifically at the rng.CreateNames point.
Sub RowNames()
Dim ws As Worksheet, firstCol As Long, lastCol As Long, rowNum As Long, r As Integer, n As Integer, rng As Range, rngName As Range
Set ws = ThisWorkbook.Sheets("MonthlySales")
Set rng = ws.Range("B2:N41")
For n = 1 To rng.Rows.Count
For r = rng.Columns.Count To 1 Step -1
rowNum = rng.Rows(n).Row
firstCol = rng.Columns(1).Column
lastCol = rng.Columns(r).Column
If Cells(firstCol, rowNum).Value <> "" Then
Set rngName = Range(Cells(firstCol, rowNum), Cells(lastCol, rowNum))
rngName.CreateNames Left:=True
Exit For
End If
Next r
Next n
End Sub
Naming Row Ranges
Range.CreateNames Method
Frankly, never heard of it. Basically, in this case, you take a range and write different names in its first column and when you loop through the rows, for each row you write something like Range("A1:D1").CreateNames Left:=True to create a named range whose name is the value in A1 and it will refer to the range B1:D1.
To mix it up, this example (I think OP also) assumes that there might be blank cells in the first column, and the number of cells in each row range may vary. Each row range will be checked backwards for a value which will define its size.
The Code
Option Explicit
Sub RowNames()
' Define worksheet.
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("MonthlySales")
' Define Source Range.
Dim rng As Range
Set rng = ws.Range("B2:N41")
' Define Columns Count.
Dim ColumnsCount As Long
ColumnsCount = rng.Columns.Count
Dim RowRange As Range ' Current Row Range
Dim r As Long ' Source Range Rows Counter
Dim c As Long ' Source Range / Current Row Range Columns Counter
' Loop through rows of Source Range.
For r = 1 To rng.Rows.Count
' Create a reference to the current Row Range.
Set RowRange = rng.Rows(r)
' Check if first cell of current Row Range contains a value,
' making it a possible candidate for a defined name.
If RowRange.Cells(1).Value <> "" Then
' Loop through cells (columns) of current Row Range backwards.
For c = ColumnsCount To 2 Step -1
' Check if current cell in current Row Range contains a value.
If RowRange.Cells(c) <> "" Then
' Create a named range from value in first cell. The range
' is defined from the second cell to to current cell
' in current Row Range.
RowRange.Cells(1).Resize(, c).CreateNames Left:=True
' Exit loop, we got what we came for (the named range).
Exit For
End If
Next c
End If
Next r
End Sub
I am trying to create something that is capable of taking the value from one text box, searching a group of column headers to find the correct one, and then placing a new value from a second text box into the last row under that column. I adapted this code that I found on here, https://stackoverflow.com/a/37687346/13073514, but I need some help. This code posts the value from the second text box under every header, and I would like it to only post it under the header that is found in textbox 1. Can anyone help me and explain how I can make this work? I am new to vba, so any explanations would be greatly appreciated.
Public Sub FindAndConvert()
Dim i As Integer
Dim lastRow As Long
Dim myRng As Range
Dim mycell As Range
Dim MyColl As Collection
Dim myIterator As Variant
Set MyColl = New Collection
MyColl.Add "Craig"
MyColl.Add "Ed"
lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 1 To 25
For Each myIterator In MyColl
If Cells(1, i) = myIterator Then
Set myRng = Range(Cells(2, i), Cells(lastRow, i))
For Each mycell In myRng
mycell.Value = Val(mycell.Value)
Next
End If
Next
Next
End Sub
Basic example:
Sub tester()
AddUnderHeader txtHeader.Text, txtContent.Text
End Sub
'Find header 'theHeader' in row1 and add value 'theValue' below it,
' in the first empty cell
Sub AddUnderHeader(theHeader, theValue)
Dim m
With ThisWorkbook.Sheets("Data")
m = Application.Match(theHeader, .Rows(1), 0)
If Not IsError(m) Then
'got a match: m = column number
.Cells(.Rows.Count, m).End(xlUp).Offset(1, 0).Value = theValue
Else
'no match - warn user
MsgBox "Header '" & theHeader & "' not found!", vbExclamation
End If
End With
End Sub
I have commented your code for your better understanding. Here it is.
Public Sub FindAndConvert()
Dim i As Integer
Dim lastRow As Long
Dim myRng As Range
Dim myCell As Range
Dim MyColl As Collection
Dim myIterator As Variant
Set MyColl = New Collection
MyColl.Add "Craig"
MyColl.Add "Ed"
Debug.Print MyColl(1), MyColl(2) ' see output in the Immediate Window
' your code starts in the top left corner of the sheet,
' moves backward (xlPrevious) from there by rows (xlByRows) until
' it finds the first non-empty cell and returns its row number.
' This cell is likely to be in column A.
lastRow = ActiveSheet.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
For i = 1 To 25 ' do the following 25 times
' in Cells(1, i), i represents a column number.
' 1 is the row. It never changes.
' Therefore the code will look at A1, B1, C1 .. until Y1 = cells(1, 25)
For Each myIterator In MyColl ' take each item in MyColl in turn
If Cells(1, i) = myIterator Then
' set a range in the column defined by the current value of i
' extend it from row 2 to the lastRow
Set myRng = Range(Cells(2, i), Cells(lastRow, i))
' loop through all the cells in myRng
For Each myCell In myRng
' convert the value found in each cell to a number.
' in this process any non-numeric cells would become zero.
myCell.Value = Val(myCell.Value)
Next myCell
End If
Next myIterator
Next i
End Sub
As you see, there is no TextBox involved anywhere. Therefore your question can't be readily understood. However, my explanations may enable you to modify it nevertheless. It's all a question of identifying cells in the worksheet by their coordinates and assigning the correct value to them.
Edit/Preamble
Sorry, didn't read that you want to use TextBoxes and to collect data one by one instead of applying a procedure to a whole data range.
Nevertheless I don't remove the following code, as some readers might find my approach helpful or want to study a rather unknown use of the Application.Match() function :)
Find all header columns via single Match()
This (late) approach assumes a two-column data range (header-id and connected value).
It demonstrates a method how to find all existant header columns by executing a single Application.Match() in a ►one liner ~> see step [3].
Additional feature: If there are ids that can't be found in existant headers the ItemCols array receives an Error items; step [4] checks possible error items adding these values to the last column.
The other steps use help functions as listed below.
[1] getDataRange() gets range data assigning them to variant data array
[2] HeaderSheet() get headers as 1-based "flat" array and sets target sheet
[3] see explanation above
[4] nxtRow() gets next free row in target sheet before writing to found column
Example call
Sub AddDataToHeaderColumn()
'[1] get range data assigning them to variant data array
Dim rng As Range, data
Set rng = getDataRange(Sheet1, data) ' << change to data sheet's Code(Name)
'[2] get headers as 1-based "flat" array
Dim targetSheet As Worksheet, headers
Set targetSheet = HeaderSheet(Sheet2, headers)
'[3] match header column numbers (writing results to array ItemCols as one liner)
Dim ids: ids = Application.Transpose(Application.Index(data, 0, 1))
Dim ItemCols: ItemCols = Application.Match(ids, Array(headers), 0)
'[4] write data to found column number col
Dim i As Long, col As Long
For i = 1 To UBound(ItemCols)
'a) get column number (or get last header column if not found)
col = IIf(IsError(ItemCols(i)), UBound(headers), ItemCols(i))
'b) write to target cells in found columns
targetSheet.Cells(nxtRow(targetSheet, col), col) = data(i, 2)
Next i
End Sub
Help functions
I transferred parts of the main procedure to some function calls for better readibility and as possible help to users by demonstrating some implicit ByRef arguments such as [ByRef]mySheet or passing an empty array such as data or headers.
'[1]
Function getDataRange(mySheet As Worksheet, data) As Range
'Purpose: assign current column A:B values to referenced data array
'Note: edit/corrected assumed data range in columns A:B
With mySheet
Set getDataRange = .Range("A2:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
data = getDataRange ' assign range data to referenced data array
End With
End Function
'[2]
Function HeaderSheet(mySheet As Worksheet, headers) As Worksheet
'Purpose: assign titles to referenced headers array and return worksheet reference
'Note: assumes titles in row 1
With mySheet
Dim lastCol As Long: lastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
headers = Application.Transpose(Application.Transpose(.Range("A1").Resize(1, lastCol)))
End With
Set HeaderSheet = mySheet
End Function
'[4]
Function nxtRow(mySheet As Worksheet, ByVal currCol As Long) As Long
'Purpose: get next empty row in currently found header column
With mySheet
nxtRow = .Cells(.Rows.Count, currCol).End(xlUp).Row + 1
End With
End Function
I need some advice for my code. I really appreciate if some members can edit my code. Thanks
My code below is looking for the name on column B and copy the result on another sheet if 2 conditions met:
- The row.value on column G = "ongoing"
- The row.value on column C = "HP"
When I run this code, got an error-message box "Range of Object"_Worksheet failed.
I am trying to change the set "mytable to ShSReturn.ListObject ("Survey Return")" with mytable as Range, another message error "Subscription out of range"
Sub LOf()
Dim cell As Variant
Dim myrange As Long, lastrow As Long, finalrow As Long, resultrow As Long
Dim mytable As Range
lastrow = ShSReturn.Range("G" & ShSReturn.Rows.Count).End(xlUp).Row
finalrow = ShSReturn.Range("C" & ShSReturn.Rows.Count).End(xlUp).Row
resultrow = ShSReturn.Range("B" & ShSReturn.Rows.Count).End(xlUp).Row
Set mytable = ShSReturn.ListObjects("Survey Return")
cell = 7
For Each cell In mytable
If mytable.Cells(cell, lastrow).Value = "Ongoing" _
And mytable.Cells(cell, finalrow).Value = "HP" Then
mytable.Cells(cell, resultrow).Copy
ShPPT.Cells(cell, 17).PasteSpecial xlPasteValues
resultrow = resultrow + 1
End If
Next cell
End Sub
I think there's some confusion about the nature of your ListObject, as specified in your original code (see comments to the question). When you select a bunch of cells and go to Insert -> Table, then as well as the table object, Excel defines a Range with the name of that table: a named Range. This Range may be referenced directly in VBA as such:
Set mytable = Range("Table1")
Note that Range names may not contain spaces
On the assumption that you have a named Range, it might be something like this:
Sub LOf()
Dim myrange As Long, lastrow As Long, finalrow As Long, resultrow As Long
Dim mytable As Range
lastrow = ShSReturn.Range("G" & ShSReturn.Rows.Count).End(xlUp).Row
finalrow = ShSReturn.Range("C" & ShSReturn.Rows.Count).End(xlUp).Row
resultrow = ShSReturn.Range("B" & ShSReturn.Rows.Count).End(xlUp).Row
Set mytable = ActiveSheet.Range("SurveyReturn") ' It's best to specify which sheet your source data is on. Presumably "ShSReturn" is the CodeName of your results sheet
Dim x As Long
For x = 7 To mytable.Cells(mytable.Cells.Count).Row ' Start at Row 7, and finish at the row number of the last cell in that Range
If mytable.Cells(x, **lastrow**).Value = "Ongoing" And mytable.Cells(x, **finalrow**).Value = "HP" Then
mytable.Cells(x, **resultrow**).Copy
ShPPT.Cells(cell, 17).PasteSpecial xlPasteValues
resultrow = resultrow + 1
End If
Next x
End Sub
Note that the above code will not work in its present form. What I have done is an approximation of what I think you're looking for: however you're going to have to do a bit of work, because the code in your question has some fundamental issues. For example, in your code you have lines like this:
mytable.Cells(cell, resultrow).Copy
However addressed cells within Ranges are in the format Range.Cells(Row, Column) - where Row and Column are numbers. However in your code resultrow as defined at the top is a Row, not a Column. You need to work out what exactly you want to copy, in terms of which row/column and re-write your code accordingly.
If you want to provide clarity, I'll be happy to edit my answer to accommodate what you want.
I have multi-tables in one sheet, how to collect my interested data from them.
for example, I just need the data of table1 column 3, and table2 column 2.
the size for both tables may be variate. I need collect the data into array for next processing.
Thanks.
You need to find a way to restrict the tables in VBA, i.e. know in which row they start and of how many rows they consist. Because the tables can appear anywhere in the sheet with variate dimensions, there is no straight-forward way of extracting their data.
What I would suggest is to loop from the top to the lastrow of the sheet and on every row check if the table started and then in an inner loop iterate through the table rows until the table ends (i.e. an empty row is encountered).
The code might look similar to this (not tested):
Dim LastRow as Long, i as Long, k as Long
Dim sht as Worksheet
LastRow = sht.Cells(sht.Rows.Count, "A").End(xlUp).Row 'Assuming the tables start in column A
For i=1 to LastRow
If (sht.Range("A" & i) <> "" Then 'table is encountered
k = i
Do While sht.Range("A" & k) <> ""
... 'Get data from specific column
k = k + 1
Loop
End if
i = k
Next i
Try this (necessary comments are in code):
Option Explicit
Sub CollectData()
Dim table1Address As String, table2Address As String
' here you specify cells that are at the start of a column
table1Address = "B2"
table2Address = "C7"
Dim firstCell As Range, lastCell As Range
Dim table1Data, table2Data As Variant
' determine last cell in column and read whole column at once to an array variable
Set firstCell = Range(table1Address)
Set lastCell = Range(table1Address).End(xlDown)
table1Data = Range(firstCell, lastCell).Value2
Set firstCell = Range(table2Address)
Set lastCell = Range(table2Address).End(xlDown)
table2Data = Range(firstCell, lastCell).Value2
End Sub
I need help with finding the last row in a worksheet range.
For example:
Worksheet name is MyWorksheet
Range is A1:A200
What im trying to find out is the row number of the last cell that has data in the MyWorksheet range A1:A200.
Define your Range, Set it and use .Find
Here is a good example of what you are trying to accomplish.
Excel VBA Find row number of matching value
Hope this helps.
Taking into account all possible data layouts, inside and outside the range of interest requires consideration of a number of factors
In general, the range of interest may be of any size, anywhere on the sheet
There may be data adjacent to the range of interest, either above or below
The range of interest may be entirely empty
Is the "Last Row Number" required relative to the Range of Interest, or the Sheet
Note: this code treats cells containing an empty string as containing data
Function RangeLastRow(r As Range, _
Optional Col = 1, _
Optional RelativeToSheet As Boolean = False) As Long
Dim rw As Long
With r.Cells(r.Rows.Count, Col)
If IsEmpty(.Value2) Then
rw = .End(xlUp).Row
If rw < r.Row Then
rw = r.Row
End If
Else
rw = r.Row + r.Rows.Count - 1
End If
End With
If IsEmpty(r.Cells(rw - r.Row + 1, Col)) Then
' range is empty
rw = 0
Else
If Not RelativeToSheet Then
rw = rw - r.Row + 1
End If
End If
RangeLastRow = rw
End Function
Use it as a UDF on a sheet, or in VBA like this
Sub Demo()
Using default Column 1 and Relative to Sheet
MsgBox RangeLastRow(Worksheets("MyWorksheet").Range("A1:A200"))
End Sub