I want to automatically add a row if the last row is filled of my listobject. But the listobject is not identified on the if statement, and when I set variable tbl to the listobject it says the subscript is out of range.
With Sheets("Ruimtelijst")
lastRow = .Cells(Cells.Rows.Count, "G").End(xlUp).Row
End With
For Row= 4 To lastRow
With Sheets("Uitwendige scheidingen")
'Intersect is not working either.
'If Not Intersect(Target, .ListObjects("Table_" & Row - 3)) Is Nothing Then
Set tbl = .ListObjects("Table_" & Row - 3)
'End If
End With
Next
code to add the listrows:(in another module)
Set tbl= .ListObjects.Add(xlSrcRange, Source:=.Range("F" & NextRow + 11 & ":G" & NextRow + 11), XlListObjectHasHeaders:=xlYes)
tbl.Name = "Table " & Rij - 3
and as you can see. the listobject is added in excel:(GrondWand is the original table name, changed it to english for here)
I've tried:
changing Sheets("Uitwendige scheidingen") to Sheets(Sheet2) (apparently Sheet2 doesn't exist)
Sheet2.ListObjects("table_1") instead of Sheet2.ListObjects("Table_" Row - 3)
Copied the table name in excel and pasted it in the Set tbl = .ListObjects("Table_" & Row - 3) line
maybe you can adjust this to your needs? Again, I'm unsure what exactly you want so I wrote it as generic as I could.
Sub test()
'Goes through all sheets
For i = 1 To ThisWorkbook.Sheets.Count
'And through all listobjects on those sheets.
For j = 1 To ThisWorkbook.Sheets(i).ListObjects.Count
'Just for your info: to see names and references?
Debug.Print "Sheet, Listobject number and its name: " & i & " " & j & " " & ThisWorkbook.Sheets(i).ListObjects(j).Name
'Find the last row
LastRowOfThisListObject = ThisWorkbook.Sheets(i).ListObjects(j).DataBodyRange.Rows.Count
'If that row (first column) is not empty then
If Not ThisWorkbook.Sheets(i).ListObjects(j).Range(LastRowOfThisListObject, 1) Like "" Then
'Add another empty row below
ThisWorkbook.Sheets(i).ListObjects(j).ListRows.Add
'If you also want to write to it go with this:
' With ThisWorkbook.Sheets(i).ListObjects(j).ListRows.Add
' .Range.ClearFormats
' .Range(1, 1) = " "
' .Range(1, 2) = " "
' .Range(1, 3) = " "
' etc.
' Call OtherSub(.Range) '...for example
' End With
End If
Next
Next
End Sub
Edit to answer a follow up.
This works for me:
Sub test2()
Set target = ThisWorkbook.Sheets(1).Range("A1:D5")
'The table is in Range("B4:I15")
Row = 4
With Sheets(1)
If Not Intersect(target, .ListObjects("Tabelle" & Row - 3).Range) Is Nothing Then
Debug.Print "test"
End If
End With
End Sub
PS: its really difficult to guess where you defined what with the limited code you showed. I just made a table and defined some range to test it. I think your error is the missing .range. Hope you can adjust this as needed
Related
I need a macro to add text to blank cells in Column A. The macro needs to skip cells that have text. The macro needs to stop looping at the end of the data set.
I am trying to use an If Else statement, but I think I'm on the wrong track. My current, non-working code is below. Thank you so much - I'm still new to VBA
Sub ElseIfi()
For i = 2 To 100
If Worksheets("RawPayrollDump").Cells(2, 1).Value = "" Then
Worksheets("RawPayrollDump").Cells(2, 1).Value = "Administration"
Else if(not(worksheets("RawPayrollDump").cells(2,1).value="")) then 'go to next cell
End If
Next
End Sub
To find the last row of data, use the End(xlUp) function.
Try this code. It replaces all empty cells in column A with Administration.
Sub ElseIfi()
Set ws = Worksheets("RawPayrollDump")
lastrow = ws.Cells(Rows.Count, 1).End(xlUp).Row ' last data row
For i = 2 To lastrow ' all rows until last data row
If ws.Cells(i, 1).Value = "" Then ' column A, check if blank
ws.Cells(i, 1).Value = "Administration" ' set text
End If
Next
End Sub
There is no need to loop. Please try this code.
Sub FillBlanks()
Dim Rng As Range
With Worksheets("RawPayrollDump")
Set Rng = Range(.Cells(2, "A"), .Cells(.Rows.Count, "A").End(xlUp))
End With
On Error Resume Next
Set Rng = Rng.SpecialCells(xlCellTypeBlanks)
If Err Then
MsgBox "There are no blank cells" & vbCr & _
"in the specified range.", _
vbInformation, "Range " & Rng.Address(0, 0)
Else
Rng.Value = "Administration"
End If
End Sub
Replace Blanks feat. CurrentRegion
Range.CurrentRegion
Since OP asked for "... stop looping at the end of the data set. ",
I've written this CurrentRegion version.
As I understand it, the end of the data set doesn't mean that there
cannot be blank cells below the last cell containing data in column
A.
Use the 1st Sub to test the 2nd, the main Sub (replaceBlanks).
Adjust the constants including the workbook (in the 1st Sub) to fit your needs.
Criteria is declared as Variant to allow other data types not just strings.
The Code
Option Explicit
Sub testReplaceBlanks()
Const wsName As String = "RawPayrollDump"
Const FirstCellAddress As String = "A2"
Const Criteria As Variant = "Administration"
Dim wb As Workbook: Set wb = ThisWorkbook
Dim ws As Worksheet: Set ws = wb.Worksheets(wsName)
replaceBlanks ws, FirstCellAddress, Criteria
End Sub
Sub replaceBlanks(Sheet As Worksheet, _
FirstCellAddress As String, _
Criteria As Variant)
' Define column range.
Dim ColumnRange As Range
Set ColumnRange = Intersect(Sheet.Range(FirstCellAddress).CurrentRegion, _
Sheet.Columns(Sheet.Range(FirstCellAddress) _
.Column))
' To remove the possibly included cells above the first cell:
Set ColumnRange = Sheet.Range(Range(FirstCellAddress), _
ColumnRange.Cells(ColumnRange.Cells.Count))
' Note that you can also use the addresses instead of the cell range
' objects in the previous line...
'Set ColumnRange = sheet.Range(FirstCellAddress, _
ColumnRange.Cells(ColumnRange.Cells.Count) _
.Address)
' or a mixture of them.
' Write values from column range to array.
Dim Data As Variant
If ColumnRange.Cells.Count > 1 Then
Data = ColumnRange.Value
Else
ReDim Data(1 To 1, 1 To 1): Data(1, 1) = ColumnRange.Value
End If
' Modify array.
Dim i As Long, k As Long
For i = 1 To UBound(Data)
If IsEmpty(Data(i, 1)) Then Data(i, 1) = Criteria: k = k + 1
Next i
' Write modified array to column range.
' The following line is used when only the first cell is known...
'Sheet.Range(FirstCellAddress).Resize(UBound(Data)).Value = Data
' ...but since the range is known and is the same size as the array,
' the following will do:
ColumnRange.Value = Data
' Inform user.
If k > 0 Then GoSub Success Else GoSub Fail
Exit Sub
' Subroutines
Success:
MsgBox "Wrote '" & Criteria & "' to " & k & " previously " _
& "empty cell(s) in range '" & ColumnRange.Address & "'.", _
vbInformation, "Success"
Return
Fail:
MsgBox "No empty cells in range '" & ColumnRange.Address & "'.", _
vbExclamation, "Nothing Written"
Return
End Sub
I need to calculate a range which contains just a single cell. This cell is from the last line and first column. If the sheet is empty the range is A1:A1.
I know there are plenty of ways to calculate the last line, but I'm looking for an elegant way to get the first cell of the last line. Maybe some examples explain better.
Example #1
A B C D
1
2 X
3 X
4 X
Result #1
Range = A4:A4
Example #2
A B C D
1
Result #2
Range = A1:A1
How to do this?
If I have understood correctly, you want find the last row across some range (or bunch of columns).
One way to achieve this might be to loop over each column within the range, find what row the last cell (in that particular column), and check if it exceeds whatever the greatest last row has been thus far in the loop.
In the code below, if you change "Sheet1" to whatever your sheet is called, and change the range from "A4:Z5" to something like "A:Z" or "A1:D4" (or whatever it is in your case), it should then display the address of the cell you're after.
Option Explicit
Private Sub ShowLastCell()
' Change this to what your sheet is called.
With ThisWorkbook.Worksheets("Sheet1")
' Change this to the range you need to check.
With .Range("A4:Z5")
Dim firstColumnToCheck As Long
firstColumnToCheck = .Columns(1).Column
Dim lastColumnToCheck As Long
lastColumnToCheck = .Columns(.Columns.Count).Column
End With
Dim maxLastRow As Long
Dim columnIndex As Long
For columnIndex = firstColumnToCheck To lastColumnToCheck
maxLastRow = Application.Max(maxLastRow, .Cells(.Rows.Count, columnIndex).End(xlUp).Row)
Next columnIndex
MsgBox ("I think the cell you want is " & .Cells(maxLastRow, "A").Address & ":" & .Cells(maxLastRow, "A").Address)
End With
End Sub
GetFirstCellInLastLine will return the first cell in the last line of the referenced worksheet as a Range object. Then you can do what you want with it. For example, printing to Immediate Window for the active sheet:
Debug.Print GetFirstCellInLastLine(ActiveSheet).Address
It is setup to return Noting if the worksheet is blank, but you can modify this according to your needs:
'''
''' Returns the first used cell in the last line of the worksheet.
''' Returns "Nothing" if the worksheet is blank.
'''
Public Function GetFirstCellInLastLine(ws As Excel.Worksheet) As Excel.Range
Dim rng As Excel.Range
Set rng = ws.UsedRange.Cells(ws.UsedRange.Rows.Count, 1)
If ((ws.UsedRange.Columns.Count > 1) And ws.Range(rng, rng.End(xlToRight)).Columns.Count <= ws.UsedRange.Columns.Count) Then
Set rng = ws.Range(rng, rng.End(xlToRight))
If VBA.IsEmpty(rng.Cells(1, 1)) Then
Set rng = rng.Cells(1, rng.Columns.Count)
Else
Set rng = rng.Cells(1, 1)
End If
ElseIf (ws.UsedRange.Columns.Count = 1) And VBA.IsEmpty(rng.Cells(1, 1)) Then
Set rng = Nothing
End If
Set GetFirstCellInLastLine = rng
End Function
Last Used Row & Specified Column Intersection feat. UsedRange
One of the elegant ways would be to use the UsedRange property.
Advanced Version
'*******************************************************************************
' Purpose: Using the UsedRange Property, creates a reference to the cell *
' range at the intersection of the last used row and a specified *
' column in a worksheet and prints its address and the address *
' of the UsedRange to the Immediate Window. *
'*******************************************************************************
Sub LastUR_Column_UsedRange()
Const cVntCol As Variant = "A" ' Column
Dim objRngT As Range ' Target Range
With ThisWorkbook.Worksheets("Sheet1")
If .Cells(.UsedRange.Rows.Count + .UsedRange.Row - 1, cVntCol).Row = 1 _
And .Cells(1, Columns.Count).End(xlToLeft).Column = 1 _
And IsEmpty(.Cells(1, 1)) Then
Debug.Print "objRngT = Nothing (Empty Worksheet)"
Else
Set objRngT = .Cells(.UsedRange.Rows.Count + .UsedRange.Row - 1, cVntCol)
Debug.Print "objRngT = " & objRngT.Address & " calculated from the " _
& "used range (" & .UsedRange.Address & ")."
Set objRngT = Nothing
End If
End With
End Sub
'*******************************************************************************
Lesson Version
'*******************************************************************************
' Purpose: Using the UsedRange Property, creates a reference to the cell *
' range at the intersection of the last used row and a specified *
' column in a worksheet and prints subresults and its address *
' to the Immediate Window. *
'*******************************************************************************
Sub LastUR_Column_UsedRange_Lesson()
' When you declare the column as variant you can use
' column letter or number e.g. "A" or 1, "D" or 4 ...
Const cVntCol As Variant = "A" ' Column
Dim objRngT As Range ' Target Range
Dim lngLast As Long ' Last Row
Dim lngRows As Long ' Number of Rows
Dim lngFirst As Long ' First Row
With ThisWorkbook.Worksheets("Sheet1")
' Finding first row and number of rows is easy.
lngFirst = .UsedRange.Row
Debug.Print "lngFirst = " & lngFirst
lngRows = .UsedRange.Rows.Count
Debug.Print "lngRows = " & lngRows
' Note1: Only when there is data in the first row, the number of rows
' is equal to the last row.
' Therefore we have to calculate the last row.
lngLast = lngRows + lngFirst - 1
Debug.Print "lngLast = " & lngLast
' Now imagine you have the first data in row 2, and you have 3 rows
' which would mean the last data is in row 4 (rows 2, 3, 4). So when you add
' 2 + 3 = 5, you have to subtract 1 row, because you counted row 2 twice.
' Note2: If there is data in the first row then lngFirst = 1.
' So the formula will calculate:
' lnglast = lngRows + 1 - 1
' lngLast = lngRows + 0
' which proves the statement in Note1.
' The previous three lines could have been written in one line:
lngLast = .UsedRange.Rows.Count + .UsedRange.Row - 1
Debug.Print "lngLast = " & lngLast & " (One Row Version)"
' Now we have all the ingredients for the Target Range.
Set objRngT = .Cells(lngLast, cVntCol)
Debug.Print "objRngT = " & objRngT.Address _
& " (Before Check if Empty)"
' And again all this could have been written in one line:
Set objRngT = .Cells(.UsedRange.Rows.Count + .UsedRange.Row - 1, cVntCol)
Debug.Print "objRngT = " & objRngT.Address & " (One Row Version)" _
& " (Before Check if Empty)"
' then you wouldn't need variables lngLast, lngFirst and lngRows. On the
' other hand you wouldn't have learned how this big formula was created.
' Now the problem is that if the worksheet is empty, UsedRange will show
' the cell in the first row as the used range. So we have to address this
' issue by checking if all of the following three conditions are true.
' - Check if the resulting cell range is in the first row (1).
' - Check if from the end of the first row to the beginning the result
' is the first cell (1) (all other cells are empty).
' - Check if the cell ("A1") is empty.
If objRngT.Row = 1 And _
.Cells(1, Columns.Count).End(xlToLeft).Column = 1 And _
IsEmpty(.Cells(1, 1)) Then
Debug.Print "objRngT = Nothing (Empty Worksheet)"
Else
Debug.Print "objRngT = " & objRngT.Address
End If
' Although this is a working code, we can conclude that we should have done
' this checking at the beginning which will be done in the advanced version.
End With
Set objRngT = Nothing
End Sub
'*******************************************************************************
Last Used Row & Specified Column Intersection feat.
The Find Method
I would call this the safest and most elegant way: using the Find method.
'*******************************************************************************
' Purpose: Using the Find method, creates a reference to the cell range at *
' the intersection of the last used row and a specified column *
' in a worksheet and prints its address to the Immediate window. *
'*******************************************************************************
Sub LastUR_Column_Find()
Const cVntCol As Variant = "A" ' Column Letter or Number ("A" or 1)
Dim objRngT As Range ' Target Range
With ThisWorkbook.Worksheets("Sheet1")
If Not .Cells.Find("*", .Cells(.Rows.Count, .Columns.Count), -4123, , 1) _
Is Nothing Then
Set objRngT = .Cells(.Cells.Find("*", , , , , 2).Row, cVntCol)
Debug.Print "objRngT = " & objRngT.Address
Set objRngT = Nothing
Else
Debug.Print "objRngT = Nothing (Empty Worksheet)"
End If
End With
End Sub
'*******************************************************************************
' Remarks: If you carefully study the "Find method as it applies to *
' the Range object." from "Visual Basic Help", you will realize *
' why exactly those four arguments and their parameters in *
' the If statement must be included and why three of them can *
' be omitted, but a new one has to be added in the Else clause. *
'*******************************************************************************
I have a spreadsheet which is used enterprise-wide. I am trying to put in checks such that certain fields are required. Specifically, columns B (last name) AND C (first name) are required, OR Column D (Organization) is required. However, B, C, and D cannot all three be filled in. If the row has any data at all in it, B and C or D are required.
My idea is to put in a button to run this macro. That I can do.
I've tried many things at this point. I can include the spreadsheet in case anyone can offer any insight. I had a macro that worked on a test sheet, but does not work on this sheet, if that will help at all.
Here is the macro
Sub CheckVal2()
Dim ws As Worksheet
Dim wsCurr As Worksheet
Dim cel As Range
Dim lngLastRow As Long
Dim lngRow As Long
For Each ws In Worksheets
If Left$(ws.Name, 7) = "Current" Then
Set wsCurr = ws
Exit For
End If
Next
With wsCurr
lngLastRow = .Range("B5000").End(xlUp).Row
For lngRow = 2 To lngLastRow
For Each cel In .Range("B" & lngRow & ":E" & lngRow)
If cel = "" Then
MsgBox "First and Last Name or HCO must be populated."
Cancel = True
Exit Sub
End If
If cel <> "" Then
If .Cells(lngRow, "D") = "" Then
If .Cells(lngRow, "B") = "" Or _
.Cells(lngRow, "C") = "" Then
MsgBox "First and Last Name or HCO must be populated."
Cancel = True
Exit Sub
End If
End If
End If
Next
Next
End With
'
End Sub
Once you get past whatever is causing the error trying to access wsCurr (which I suspect is just a case of the worksheet not existing), you should modify your code as follows:
With wsCurr
lngLastRow = .Range("E5000").End(xlUp).Row
For lngRow = 2 To lngLastRow
'First check whether first/last name has been consistently advised
If (.Cells(lngRow, 2) = "") <> _
(.Cells(lngRow, 3) = "") Then
MsgBox "Row " & lngRow & " - First Name and Last Name must both be advised or both be blank"
Cancel = True ' I assume this is a global variable?
Exit Sub
End If
'Now check that last name has not been advised if HCO has been, and vice-versa
If (.Cells(lngRow, 2) = "") = _
(.Cells(lngRow, 4) = "") Then
MsgBox "Row " & lngRow & " - First and Last Name, or HCO, must be populated but not both."
Cancel = True
Exit Sub
End If
Next
End With
This will get around the existing problem with your tests, which (as far as I can tell) aren't allowing for the case where all three columns have been advised.
I also changed the column on which lngLastRow was being set because, if it is set based on column B and the last row(s) of your data only contained values in column C and/or D, those final row(s) would not be being tested.
I have this code (This code is in Access VBA which tries to read an excel file and after checking, possibly import it):
Set ExcelApp = CreateObject("Excel.application")
Set Workbook = ExcelApp.Workbooks.Open(FileName)
Set Worksheet = Workbook.Worksheets(1)
now I want to iterate over all rows of the excel worksheet. I want something such as this:
for each row in Worksheet.rows
ProcessARow(row)
next row
where
function ProcessARow(row as ???? )
' process a row
' how Should I define the function
' how can I access each cell in the row
' Is there any way that I can understand how many cell with data exist in the row
end function
My questions:
How to define the for each code that it iterate correctly on all
rows that has data?
How to define ProcessARow properly
How to get the value of each cell in the row.
How to find how many cell with data exist in the row?
Is there any way that I detect what is the data type of each cell?
edit 1
The link solves on problem :
How to define the for each code that it iterate correctly on all rows that has data?
but what about other questions?
For example, how to define ProcessARow correctly?
If you need the values in the Row, you need use the 'Value' Property and after do an cycle to get each value
for each row in Worksheet.rows
Values=row.Value
For each cell in Values
ValueCell=cell
next cell
next row
Unfortunately you questions are very broad however I believe the below sub routine can show you a few ways of achieving what you are after. In regards to what datatype each cell is more involved as it depends what data type you wish to compare it to however I have included some stuff to hopefully help.
sub hopefullyuseful()
dim ws as worksheet
dim rng as Range
dim strlc as string
dim rc as long, i as long
dim lc as long, j as long
dim celltoprocess as range
set ws = activeworkbook.sheets(activesheet.name)
strlc = ws.cells.specialcells(xlcelltypeLastCell).address
set rng = ws.range("A1:" & lc)
rc = rng.rows.count()
debug.print "Number of rows: " & rc
lc = rng.columns.count()
debug.print "Number of columns: " & lc
'
'method 1 looping through the cells'
for i = 1 to rc
for j = 1 to lc
set celltoprocess = ws.cells(i,j)
'this gives you a cell object at the coordinates of (i,j)'
'[PROCESS HERE]'
debug.print celltoprocess.address & " is celltype: " & CellType(celltoprocess)
'here you can do any processing you would like on the individual cell if needed however this is not the best method'
set celltoprocess = nothing
next j
next i
'method 2 looping through the cells using a for each loop'
for each celltoprocess in rng.cells
debug.print celltoprocess.address & " is " & CellType(celltoprocess)
next celltoprocess
'if you just need the data in the cells and not the actual cell objects'
arrOfCellData = rng.value
'to access the data'
for i = lbound(arrOfCellData,1) to ubound(arrOfCellData,1)
'i = row'
for j = lbound(arrOfCellData,2) to ubound(arrOfCellData,2)
'j = columns'
debug.print "TYPE: " & typename(arrOfCellData(i,j)) & " character count:" & len(arrOfCellData(i,j))
next j
next i
set rng=nothing
set celltoprocess = nothing
set ws = nothing
end sub
Function CellType(byref Rng as range) as string
Select Case True
Case IsEmpty(Rng)
CellType = "Blank"
Case WorksheetFunction.IsText(Rng)
CellType = "Text"
Case WorksheetFunction.IsLogical(Rng)
CellType = "Logical"
Case WorksheetFunction.IsErr(Rng)
CellType = "Error"
Case IsDate(Rng)
CellType = "Date"
Case InStr(1, Rng.Text, ":") <> 0
CellType = "Time"
Case IsNumeric(Rng)
CellType = "Value"
End Select
end function
sub processRow(byref rngRow as range)
dim c as range
'it is unclear what you want to do with the row however... if you want
'to do something to cells in the row this is how you access them
'individually
for each c in rngRow.cells
debug.print "Cell " & c.address & " is in Column " & c.column & " and Row " & c.row & " has the value of " & c.value
next c
set c = nothing
set rngRow = nothing
exit sub
if you want your other questions answered you will have to be more specific as to what you are trying to accomplish
While I like the solution offered by #krazynhazy I believe that the following solution might be slightly shorter and closer to what you asked for. Still, I'd use the CellType function offered by Krazynhazy rather than all the Iif I currently have in the below code.
Option Explicit
Sub AllNonEmptyCells()
Dim rngRow As Range
Dim rngCell As Range
Dim wksItem As Worksheet
Set wksItem = ThisWorkbook.Worksheets(1)
On Error GoTo EmptySheet
For Each rngRow In wksItem.Cells.SpecialCells(xlCellTypeConstants).EntireRow.Rows
Call ProcessARow(wksItem, rngRow.Row)
Next rngRow
Exit Sub
EmptySheet:
MsgBox "Sheet is empty." & Chr(10) & "Aborting!"
Exit Sub
End Sub
Sub ProcessARow(wksItem As Worksheet, lngRow As Long)
Dim rngCell As Range
Debug.Print "Cells to process in row " & lngRow & ": " & wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants).Count
For Each rngCell In wksItem.Range(wksItem.Cells(lngRow, 1), wksItem.Cells(lngRow, wksItem.Columns.Count)).SpecialCells(xlCellTypeConstants)
Debug.Print "Row: " & lngRow, _
"Column: " & rngCell.Column, _
"Value: " & rngCell.Value2, _
IIf(Left(rngCell.Formula, 1) = "=", "Formula", IIf(IsDate(rngCell.Value), "Date", IIf(IsNumeric(rngCell.Value2), "Number", "Text")))
Next rngCell
End Sub
Note, that you have to call the sub to call a row must also include the sheet on which a row should be processed.
I tried for a few hours to search and look for a possible answer. I am about ready to give up. I haven't been able to find someone with a scenario quite like the one I am asking, maybe I overlooked it.
I want to find the last row in a specific range. The ranges are A7 to A21. I want to be able to enter input data from my form to the empty row within that range...
Here is where it gets tricky. I also have two other categories on the same sheet where I need to input data. Data may already be here, again I want to find the last row and then input data. Ranges A27:A41.
And the last category ranges A46:A66.
Hopefully someone here can help me out.
Define the ranges you use as tables in Excel on the sheet. Then in your code use:
Dim Table1 As listObject, Table2 As ListObject
With ThisWorkbook.Worksheets("Name of the sheet the tables are on")
Set Table1 = .ListObjects("Name of the table")
Set Table2 = .ListObjects("Name of the table")
End With
Dim LastRowT1 As Long, LastRowT2 As Long
LastRowT1 = 1: LastRowT2 = 1
Do Until Table1.DataBodyRange(LastRowT1, 1) = Empty
LastRowT1 = LastRowT1 + 1
Loop
Do Until Table2.DataBodyRange(LastRowT2, 1) = Empty
LastRowT2 = LastRowT2 + 1
Loop
'If you run out of space and automatically want to add an extra row add
'the following code.
If LastRowT1 > Table1.ListRows.Count Then
Table2.ListRows.Add AlwaysInsert:=True
End If
If LastRowT2 > Table2.ListRows.Count Then
Table2.ListRows.Add AlwaysInsert:=True
End If
The Value of LastRowT1 and LastRowT2 should be the row number (of the listobject) of the first empty row.
This should get you pointed in the right direction...
Sub Main()
Dim r1 As Range
Dim r2 As Range
Dim r3 As Range
Dim rFind As Range
'Set your range vars
Set r1 = Range("A7:A21")
Set r2 = Range("A27:A41")
Set r3 = Range("A46:A66")
'Find the next empty cell and display the address
On Error Resume Next
'First range
Set rFind = r1.Find("*", searchdirection:=xlPrevious).Offset(1, 0)
If Not rFind Is Nothing Then
MsgBox "First open cell in " & r1.Address & " is " & rFind.Address
Else
MsgBox "First open cell in " & r1.Address & " is " & r1.Cells(1, 1).Address
End If
'Second range
Set rFind = r2.Find("*", searchdirection:=xlPrevious).Offset(1, 0)
If Not rFind Is Nothing Then
MsgBox "First open cell in " & r2.Address & " is " & rFind.Address
Else
MsgBox "First open cell in " & r2.Address & " is " & r2.Cells(1, 1).Address
End If
'Third range
Set rFind = r3.Find("*", searchdirection:=xlPrevious).Offset(1, 0)
If Not rFind Is Nothing Then
MsgBox "First open cell in " & r3.Address & " is " & rFind.Address
Else
MsgBox "First open cell in " & r3.Address & " is " & r3.Cells(1, 1).Address
End If
End Sub
This assumes that you're filling the cells from the top down (e.g. A7 fills first, A8 is next, then A9, etc.). If that's not the case, then instead of .Find you'd need to use a loop. You'll definitely need to adapt this to you situation, especially the logic for when all the cells in your ranges fill up.
To make your request more generic (and hence scalable), you could create a function to find the first available row of any given range:
Function FindFirstOpenCell(ByVal R As Range) As Integer
Dim row, col As Integer
row = R.row
col = R.Column
FindFirstOpenCell = Cells(row + R.Rows.Count - 1, col).End(xlUp).row + 1
End Function
From here you could simply call the function over and over:
Dim row As Integer
row = FindFirstOpenCell(Range("A7:A21"))
Cells(row, 1).Value = "My Next Item"