I am trying to get the last used column in my formatted table and insert a value. But it's always returning the very last (=empty) column inside the table. See picture below for understanding:
For some reason, the text "- seit -" is placed into the column "10.Besitzer" in column 16 whereas it should have been put into "1.Besitzer" in column 7.
My code looks as following:
LastRow = ws.Cells(Rows.Count, 1).End(xlUp).Row + 1 '+1 to go to next empty row
'here it adds values in empty row, starting from column 1(ID) until column 6(IT).
'I left out this part of code.
LastCol = ws.Cells(LastRow, Columns.Count).End(xlToLeft).Column 'Search for last column
ws.Cells(LastRow, LastCol).Value = "- seit -" 'place text into last column
If have a feeling its causing problems because its a formatted table but I am not sure about that. I am very thankful for any help.
Yes it stops because its a table. Check if value exist and if no again check for last column same way only not Columns.Count but from the LastColumn.
Read the comments and adjust it to fit your needs
Public Sub InsertColumnValue()
' Set a reference to the table
Dim targetTable As ListObject
Set targetTable = Range("TableName").ListObject
' Find last row in column A
Dim lastRow As Long
lastRow = targetTable.DataBodyRange.Cells(targetTable.DataBodyRange.Rows.Count, "A").End(xlUp).Row - targetTable.HeaderRowRange.Row
' Add data to next empty row
' Do something
' Check if last column in last row is empty
Dim lastColumn As Long
If targetTable.DataBodyRange.Cells(lastRow, targetTable.DataBodyRange.Columns.Count).Value = vbNullString Then
lastColumn = targetTable.DataBodyRange.Cells(lastRow, targetTable.DataBodyRange.Columns.Count).End(xlToLeft).Column
Else
lastColumn = targetTable.DataBodyRange.Columns.Count
End If
' Add value to next empty column in next empty row
targetTable.DataBodyRange.Cells(lastRow + 1, lastColumn + 1).Value = "- seit -"
End Sub
Use the next function, please:
Function LastUsedColInTable(tbl As ListObject, iRow As Long) As Long
Dim C As Range
With tbl.Range.rows(iRow)
Set C = .Find(what:="*", After:=.cells(1), LookIn:=xlValues, _
searchorder:=xlByColumns, SearchDirection:=xlPrevious)
If Not C Is Nothing Then
LastUsedColInTable = C.Column
Else
LastUsedColInTable = 1
End If
End With
End Function
It can be tested in this way:
Sub testLastColInTable()
Dim tbl As ListObject
Set tbl = ActiveSheet.ListObjects(1)
Debug.Print LastUsedColInTable(tbl, 2)
End Sub
Related
Two questions:
1) I have a spreadsheet (TC) that has data on one page that will be updated daily. There are 28 columns. Essentially I am looking to have the line (row) data cut and paste into a second spreadsheet (Archive) when Col. 28 has a value entered in it. I have the base coding but for some reason it causes Excel to be non-responsive.
I think it might be because the coding goes cell by cell rather than row by row. Can anyone point me in the right direction? (Again, keep in mind, this is a snippet of the coding - I have each Cut and Paste up to Column 28.)
2) The second part of my question is: Will what I have written make sure that when the Command Button is pressed next time, the data will cut and paste to the next blank line. Thank you!
Private Sub CommandButton1_Click()
a = Worksheets("TC").Cells(Rows.Count, 2).End(xlUp).Row
'Dim rng As Range
'Set rng = Worksheets("Archived").Range("A1")
b = 1
For i = 2 To a
If Worksheets(“TC”).Cells(i, 28).Value <> "" Then
'Change # to be the number column of Pt Name
Worksheets(“TC”).Cells(i, 1).Cut
'Change ,# to be the number column of where you want it pasted.
Worksheets(“TC”).Paste Destination:=Worksheets(“Archive”).Cells(b + 1, 1)
'Change ,# to be the number column of SOC
Worksheets(“TC”).Cells(i, 2).Cut
'Change ,# to be the number column of where you want it pasted.
Worksheets(“TC”).Paste Destination:=Worksheets(“Archive”).Cells(b + 1, 2)
b = b + 1
End If
Next
Application.CutCopyMode = False
ThisWorkbook.Worksheets(“TC”).Cells(1, 1).Select
End Sub
You can do something like this:
Private Sub CommandButton1_Click()
Dim i as long, b As Long, shtTC as worksheet, shtArch as worksheet
Set shtTC = Worksheets("TC")
Set shtArch = Worksheets("Archive")
'find the first empty row
b = shtArch.Cells(Rows.Count, 2).End(xlUp).Row + 1 'pick a column which will always be populated
For i = 2 To shtTC.Cells(Rows.Count, 2).End(xlUp).Row
If shtTC.Cells(i, 28).Value <> "" Then
'cut the row
shtTc.Cells(i, 1).Resize(1, 28).Cut shtArch.Cells(b, 1)
b = b + 1
End If
Next
Application.CutCopyMode = False
shtTC.Cells(1, 1).Select
End Sub
Here's an example of how to create the kind of copy results you're looking for. Notice that, unless you specifically want to copy/paste all of the formatting with the data, you don't need to use copy/paste. You can perform the copy by assigning the values of the ranges.
Option Explicit
Private Sub CommandButton1_Click()
CopyData ThisWorkbook.Sheets("TC"), ThisWorkbook.Sheets("Archived")
End Sub
Public Sub CopyData(ByRef source As Worksheet, _
ByRef dest As Worksheet, _
Optional ByVal deleteSource As Boolean = False)
'--- calculate and create the source data range
Const TOTAL_COLUMNS As Long = 1
Dim srcRange As Range
Dim lastRow As Long
With source
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
Set srcRange = .Range("A1").Resize(lastRow, TOTAL_COLUMNS)
End With
'--- determine where the data should go
Dim destRange As Range
With dest
lastRow = .Cells(.Rows.Count, 1).End(xlUp).Row
If lastRow > 1 Then lastRow = lastRow + 1
Set destRange = .Cells(lastRow, 1)
Set destRange = destRange.Resize(srcRange.Rows.Count, TOTAL_COLUMNS)
End With
'--- now copy the data
destRange.Value = srcRange.Value
'--- optionally delete the source data
If deleteSource Then
srcRange.Clear
End If
End Sub
Simple table in sheet1 with data in cells(A2:C4), column D is empty. I want to select the entire row, cut and paste it in sheet2 when a time is added in colum D.
When I clicked on the logout button, It will add a time punch in column D.
I want that entire row to be selected and then cut and paste in sheet2.
I want also to arrange the remaining entry to move up so that there's no spaces between.
Screenshot
Dim CM As Boolean
Private Sub cmdMove_Click()
Dim myLog As Worksheet
Dim myLogSheet As Range
Dim i As Long: i = 1
Set myLog = Sheets("Sheet1")
Set myLogSheet = myLog.Range("B:B").Find(txtID.Value, , , xlWhole)
'Dim LastRow As Long
'LastRow = Sheets("Sheet2").Range("A65536").End(xlUp).Row + 1
If Not myLogSheet Is Nothing Then
myLogSheet.Offset(0, 2) = Format(Now, "hh:mm:ss")
With ActiveSheet
For n = nLastRow To nFirstRow Step -1
If .Cells(n, "D") = "" Then
.Cells(n, "D").EntireRow.Cut Sheet2.Cells(i, "A")
.Cells(n, "D").EntireRow.Delete '~~> if you want to delete
i = i + 1
End If
Next
End With
Else
txtName.Value = "NO RECORD"
End If
End Sub
You need to remove your loop, and just use the row you found using the Find:
Dim CM As Boolean
Private Sub cmdMove_Click()
Dim myLog As Worksheet
Dim myLogSheet As Range
Dim myLogSheetRow As Long
Dim i As Long
i = 1
'Probably you want:
i = Sheet2.Cells(Sheet2.Rows.Count, "A").End(xlUp).Row + 1
Set myLog = Sheets("Sheet1")
Set myLogSheet = myLog.Range("B:B").Find(txtID.Value, , , xlWhole)
If Not myLogSheet Is Nothing Then
myLogSheetRow = myLogSheet.Row ' So we can delete the row later
myLogSheet.Offset(0, 2) = Format(Now, "hh:mm:ss")
myLogSheet.EntireRow.Cut Sheet2.Cells(i, "A")
myLog.Rows(myLogSheetRow).Delete
Else
txtName.Value = "NO RECORD"
End If
End Sub
Note that Excel exhibits very odd behaviour when deleting the row after the Cut. Using a statement of myLogSheet.EntireRow.Delete after the Cut causes Excel to delete the row in Sheet1 based on the new location of the cell in Sheet2. This is why a variable needs to be created to refer to the row prior to the Cut, so that it can be used in the Delete after the Cut.
The amount of cells in my data table changes every week so I'm using a count function to determine the number of cells with data then using that count as a variable to put into my range(cells(x,x),cells(x,x) function to select. But I'm having an issue with taking the count and converting it to a variable to use. This is a basic macro I'm putting together for something else i'm doing.
Sub format_table()
Dim x As Long
Dim y As Long
''count the number of rows in rawdata table
Dim LastRow As Integer
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
x = LasRow
''count the number of columns in rawdata table
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
End With
y = LastCol
'''use the counted cells to determine a range to select
ActiveSheet.Range(Cells(1, 1), Cells(x, y)).Select
End Sub
I think you are having trouble trying to get the column number as the correct letter, right? Try something like this:
Sub Test()
Dim wb As Workbook
Set wb = ThisWorkbook
Dim ws As Worksheet
Set ws = wb.Sheets("Sheet1") '(replace with whatever sheet name is)
Dim lastRow as Integer, lastCol as Integer, lastColLet as Integer
'get the number value of the last row and column
lastRow = ws.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lastCol = ws.Cells.Find("*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
'uncomment the debug.print statements to see what it's getting for last row/column
'Debug.Print lastRow
'Debug.Print lastCol
'get the letter that the column number corresponds to
lastColLet = Letter(lastCol)
'Debug.Print lastColLet
ws.Range("A1:" & lastColLet & lastRow).Select
End Sub
Function Letter(ByVal lngCol As Long) As String
Dim vArr
vArr = Split(Cells(1, lngCol).Address(True, False), "$")
Letter = vArr(0)
End Function
It uses the function found here: Function to convert column number to letter? in order to convert the column # to a letter, then you can concat the letter and last row to select the way you wanted.
I guess your real issue is to decide what cells you actually need to select
your approach assumes that the left-upmost data cell is always in cell(1,1) and the down-right one is in the intersection of:
last non empty row in column 1, last non empty column in row 1
should that be the case, then you can go on with your code provided you change x = LasRow to x = LastRow...
should not that be the case then you could assume that the range is the one delimited by:
first non empty row in column 1, first non empty column in row 1
last non empty row in column 1, last non empty column in row 1
then you could use this code:
Function GetData() As Range
Dim firstRow As Long, firstColumn As Long
Dim LastRow As Integer, lastColumn As Long
With ActiveSheet
firstRow = .UsedRange.Rows(1).Row '<--| get first used row index
firstColumn = .UsedRange.Columns(1).Column '<--| get first used column index
LastRow = .Cells(.Rows.Count, firstColumn).End(xlUp).Row '<--| get the first used column last non empty cell row index
lastColumn = .Cells(firstRow, .Columns.Count).End(xlToLeft).Column '<--| get the first used rows last non empty cell column index
'return the range
Set GetData = .Range(Cells(firstRow, firstColumn), Cells(LastRow, lastColumn))
End With
End Function
and exploit it in your main code as follows:
Sub format_table()
With GetData '<-- use With-End With block to reference wanted object (Range) and avoid Select/Selection/Activate/ActiveXXX
'format the referenced range
.Font.Name=..
.Interior.Color=..
End With
End Sub
but the GetData() function may still be not the one you need, should data be "jagged" in columns and or/rows with first row/column not hosting the last column/cell
so maybe you simply need:
Sub format_table()
With ActiveSheet.UsedRange
'format the referenced range
' .Font.Name=..
' .Interior.Color=..
End With
End Sub
I'm at a loss on this and need some help. I've lurked around at answers and have Frankensteined together some code for a macro but it just isn't working.
Here is part of what I have so far:
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lrow = Lastrow To Firstrow Step -1
With .Cells(lrow, "G")
Range("G1").Select
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
End With
Next lrow
End With
I have a very similar block of code before this that deletes crap from the text files I'm importing and it works perfectly through all the number of rows. When I run the same thing with this formula, it only puts the formula in G1 and doesn't cycle through the rest of the sheet. I've tried this and it works, but copies down through all million plus rows:
ActiveCell.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
Selection.AutoFill Destination:=Range("G:G")
I've tried this and then run the same code that gets rid of the text file crap but I get an error "End If without block If".
To fill the formula in one cell at a time you need to cycle through them; don't keep relying on the ActiveCell property.
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
For lrow = Lastrow To Firstrow Step -1
.Cells(lrow, "G").FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
Next lrow
End With
But you can speed things up by putting the formula into all of the cells at once.
With ActiveSheet
Firstrow = 1
Lastrow = .Cells(.Rows.Count, "A").End(xlUp).Row
With .Range(.Cells(Firstrow, "G"), .Cells(Lastrow, "G"))
.FormulaR1C1 = "=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
End With
End With
See How to avoid using Select in Excel VBA macros for more methods on getting away from relying on select and activate to accomplish your goals.
Another version, to dynamically select the columns based on their titles. Comments included.
Dim row As Range
Dim cell As Range
Static value As Integer
'Set row numbers
'Find the starting row. Located using Title of column "Start" plus whatever number of rows.
Dim RowStart As Long
Set FindRow = Range("A:A").Find(What:="Start", LookIn:=xlValues)
RowStart = FindRow.row + 1
'End of the range. Located using a "finished" cell
Dim RowFinish As Long
Set FindRow = Range("A:A").Find(What:="Finished", LookIn:=xlValues)
RowFinish = FindRow.row - 1
'Set range - Goes Cells(Rownumber, Columnnumber)
'Simply ammend RowStart and RowFinish to change which rows you want.
' In your case you need to change the second column number to paste in horizontally.
Set rng = Range(Cells(RowStart, 1), Cells(RowFinish, 1))
'Start the counter from the starting row.
value = RowStart
For Each row In rng.Rows
For Each cell In row.Cells
'Insert relevant formula into each cell in range.
cell.Formula = _
"=IF(ISNUMBER(RC[1]),RC[1],RC[-1])"
'Increment row variable.
value = value + 1
Next cell
Next row
I'm fairly new to VBA and I'm having a lot of trouble doing a seemingly easy task. I've tried many different codes using this website and this is the one that gets me closest to what I want but it doesn't return any values. Here is the premise of what I need it to do:
1) Search the entire first row of columns (A1 to let's say Z1) of a worksheet for specific text such "Closed"
2) If the desired text "Closed" is found in one of the columns, copy all the values from that column
3) Paste those values from the column into Column J of another worksheet ("Source_Workbook")
****EDIT**: I want the column data to paste starting at the next empty row after row 5 of column J (10). I was having trouble using "Offset" in this case. Also, I want only the values to be pasted (keep the formatting of the page onto which the data is being pasted).
My problem is that this code keeps giving me errors when I try to do "Range.PasteSpecial." I hope I have the right approach. Please let me know if I can clarify anything further.
Dim rng As Range
Dim cl As Object
Dim strMatch As String
strMatch = "Closed" 'Search first row for columns with "Closed"
Set rng = Target_Workbook2.Sheets(2).Range("A1:Z1")
For Each cl In rng
If cl.Value = strMatch Then
cl.EntireColumn.Copy
Exit For
With Source_Workbook2.Sheets(2)
Sheets(2).Columns("J").Offset(5, 0).PasteSpecial xlPasteValues
End With
End If
Next cl
Would
Target_Workbook2.Sheets(2).Range("A1:Z1").AutoFilter 1, "*Closed*"
possibly work better for filtering?
You are exiting for loop before pasting the values on Sheet2.
Try this code:
Dim rng As Range
Dim cl As Object
Dim strMatch As String
strMatch = "Closed" 'Search first row for columns with "Closed"
Set rng = Target_Workbook2.Sheets(2).Range("A1:Z1")
For Each cl In rng
If cl.Value = strMatch Then
cl.EntireColumn.Copy Destination:=Sheets("Sheet2").Columns(10)
Exit For
End If
Next cl
Edit 1: Based on the comment
This will copy the column and paste it from row 5 on Sheet2.
Dim rng As range
Dim cl As Object
Dim strMatch As String
Dim lastrow As Long
Dim sh2lastrow As Long '<-- Newly added
Dim col As Long '<-- Newly added
Dim range As range '<-- Newly added
strMatch = "Closed" 'Search first row for columns with "Closed"
lastrow = Sheets("Sheet1").range("A65536").End(xlUp).Row ' or + 1
sh2lastrow = Sheets("Sheet2").range("J65536").End(xlUp).Row + 4 '<-- Newly added (Because you want to start from row 5)
Set rng = Sheets("Sheet1").range("A1:Z1")
For Each cl In rng
If cl.Value = strMatch Then
lastrow = Cells.CurrentRegion.Rows.Count '<-- (Getting row count of given column)
col = cl.Column '<-- (Getting column number of given column)
With Sheets("Sheet1")
Set range = .range(.Cells(2, col), .Cells(lastrow, col)) '<-- (Setting up the range to copy)
End With
range.Copy
Sheets("Sheet2").Activate '<-- Newly added
Sheets("Sheet2").range("J" & sh2lastrow).PasteSpecial xlPasteValues '<-- (Pasting the copied data)
sh2lastrow = Sheets("Sheet2").range("J65536").End(xlUp).Row + 1 '<-- (Getting the last row from Sheet2)
Sheets("Sheet1").Activate
End If
Next cl