Paste Data with AutoFill in VBA - vba

I have the code below that copies the last column filled and paste it into the next empty, simple column. However I need the pasted column to be incremented (with autofill), in my case, with date. January> February> March and so on. Today it sticks with the fixed data.
Sub Test()
Dim ws As Worksheet
Set ws = ActiveSheet
Dim rLastCell As Range
Dim LastCol As Integer
Set rLastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlFormulas, LookAt:= _
xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
LastCol = rLastCell.Column
ws.Columns(LastCol).Copy ws.Columns(LastCol + 1)
End Sub

Related

Paste column format only through iteration

I have a code that copies data from one workbook to another. Now, the 2nd column in my destination workbook has a certain color format that I need to be applied till the last column with data in it.
This is the code snippet to find the last non-empty column :
Dim rLastCell As Range
Set ws = ThisWorkbook.Sheets(DestName)
Set rLastCell = ws.Cells.Find(What:="*", After:=ws.Cells(1, 1), LookIn:=xlValues, _
LookAt:= xlPart, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False)
Dim LastCol As Long
LastCol = rLastCell.Column
MsgBox LastCol
So, now I want to iterate and paste the format from the 2nd column to all the columns until LastCol. Any help would be appreciated.
This is the solution :
lCol = Cells(1, Columns.Count).End(xlToLeft).Column
MsgBox "Last Column: " & lCol
Dim x As Long
Columns(2).Copy
For x = 3 To LastCol
Columns(x).PasteSpecial Paste:=xlPasteFormats
Next

excel vba select last row and last column

I am trying to select from A9 to the lastrow & lastcolumn.
I have this to select the last cell, but it doesn't select from A9 to Last it just selects the lastrow/lastcolumn. Also this is not ideal because if I have blanks in the future.
I have searched and could not find anything for selecting from a cell to the lastrow & lastcolumn
Sub FindLast()
Application.ScreenUpdating = False
Range("A9").End(xlToRight).End(xlDown).Select
Application.ScreenUpdating = True
End Sub
Search order in my file would be Column A & Row 8 if that helps at all.
Code Below is what I am using to work on active sheets
Sub SelectAll()
Application.ScreenUpdating = False
Dim lastRow As Long, lastCol As Long
Dim Rng As Range
Dim WholeRng As Range
With ActiveWorksheet
Set Rng = Cells
'last row
lastRow = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
'last column
lastCol = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
Set WholeRng = Range(Cells(9, "A"), Cells(lastRow, lastCol))
WholeRng.Select
End With
Application.ScreenUpdating = True
End Sub
Or you could exploit UsedRange
Sub FindLast()
With Activesheet
.Range(.Range("A9"), .UsedRange.Cells(.UsedRange.Rows.Count, .UsedRange.Columns.Count)).Select
End With
End Sub
The safest way is use the Find function:
Option Explicit
Sub LastRow_Col_Find()
' Safest way to ensure you got the last row:
Dim lastRow As Long, lastCol As Long
Dim Rng As Range
Dim WholeRng As Range
With Worksheets("report")
Set Rng = .Cells
' Safest way to ensure you got the last row
lastRow = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
'MsgBox lastRow ' <-- for DEBUG
' Safest way to ensure you got the last column
lastCol = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
'MsgBox lastColumn ' <-- for DEBUG
' set the Range for the entire UsedRange in "YourSheetName" sheet
Set WholeRng = .Range(.Cells(9, "A"), .Cells(lastRow, lastCol))
WholeRng.Select '<-- ONLY IF YOU MUST
End With
End Sub

Loop through all worksheets to find bottom-most row of data in each tab individually

I found this cool code that identifies the bottom-most row of data in a worksheet (considering all columns), and then types an X in Column B of the following row.
However I have been unsuccessful at creating a loop with this code, so that each worksheet is treated uniquely. My attempts have typed X in the same cell of all worksheets, but not each worksheet individually based on it's own set of data.
Also note that each of my tabs will not always have the same column be the longest, which is why I needed a code to look across all columns to find the bottom-most row.
Can someone suggest how I can loop this and identify the bottom-most row in each worksheet individually?
Sub EndofData()
Dim iRow As Long
Dim iCol As Long
iRow = Cells.Find(What:=”*”, _
After:=Range(“A1”), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Cells(iRow + 1, 2).Select
ActiveCell.FormulaR1C1 = “x”
End Sub
You want to do a For Each Loop:
Sub EndofData()
Dim ws As Worksheet
Dim iRow As range
Dim iCol As Long
For Each ws In ActiveWorkbook.Worksheets
set iRow = ws.Cells.Find(What:=" * ", _
After:=ws.Range("A1"), _
LookAt:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If not irow is nothing then
ws.Cells(iRow.Row + 1, 2).FormulaR1C1 = "x"
Else
ws.Cells(1, 2).FormulaR1C1 = "x"
End IF
Next ws
End Sub
Thanks to #Darren for help on the error avoidance.

How to reset FIND function result before looping to another sheet?

I would like to ask if you can help with the code below. On every sheet in my workbook there is the same kind of a table, however on each sheet the table has different location and values. I need to go through all sheets, search for table values on every sheet and then do some other operations with the values. I use Find function to determine header of the table and subsequently table range. The Find function does not work properly though as it keeps found address of "Header" cell from the first sheet for every other sheet. Is there any way to reset the found header address value before looping to another sheet? Thank you in advance.
Sub FindInDynamicRanges()
Dim wb1 As Workbook
Dim ws As Worksheet
Dim FoundCell, FoundTab, TabEntries As Excel.Range
Dim FirstAddr As String
Dim FirstRow, LastRow As Long
Set wb1 = ThisWorkbook
'Find all occurences of any table value on all sheets in dynamic ranges
For Each ws In wb1.Worksheets
Set ws = ActiveSheet
'Find "Header" cell
Set FoundCell = ws.Columns(2).Find(What:="Header", LookIn:=xlValues, LookAt:=xlWhole, SearchOrder:=xlByRows, _
SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
MsgBox FoundCell.Address
'Set number of first entry row and last entry row
FirstRow = FoundCell.Row + 1
LastRow = ws.Cells.Find(What:="*", After:=Range("A1"), LookAt:=xlPart, LookIn:=xlValues, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
ws.Range("B" & FirstRow & ":B" & LastRow).Name = "TabEntries"
MsgBox Range("TabEntries").Address
With ws.Range("TabEntries")
Set LastCell = .Cells(.Cells.Count)
End With
Set FoundTab = ws.Range("TabEntries").Find(What:="*", After:=LastCell, LookIn:=xlValues, LookAt:=xlWhole, _
SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False)
If Not FoundTab Is Nothing Then
FirstAddr = FoundTab.Address
End If
Do Until FoundTab Is Nothing
'do some staff with found values
Set FoundTab = ws.Range("TabEntries").FindNext(After:=FoundTab)
If FoundTab.Address = FirstAddr Then
Exit Do
End If
Loop
Next ws
End Sub
as it keeps found address of "Header" cell from the first sheet for every other sheet.
That is because you are telling it to...
For Each ws In wb1.Worksheets
Set ws = ActiveSheet
You don't need that Set ws = ActiveSheet
When you say For Each ws, the ws is automatically initialized. So just remove the second line.

Copy last column with data on specified row to the next blank column

I have a spread sheet and I need to look for the last column that has data in it. Then I need to copy this column and copy it to the next blank column.
Is there a way to do this?
I've managed to do it with rows using:
lastrowSrc = Sheets("Overview").Range("B" & Rows.Count).End(xlUp).Row
However this puts B12 in the range, using columns.count simply puts in the number of the column, not the letter
To get the exact column in a worksheet, use this code.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LastCol As Long
Set ws = Sheets("Sheet1")
'~~> This check is required else .FIND will give you error on an empty sheet
If Application.WorksheetFunction.CountA(ws.Cells) = 0 Then
LastCol = 1
Else
LastCol = ws.Cells.Find(What:="*", _
After:=ws.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End If
Debug.Print LastCol
End Sub
EDIT: This is courtesy #brettdj. You can also use the range object to find the last column
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LastCol As Long
Dim rng As Range
Set ws = Sheets("Sheet1")
Set rng = ws.Cells.Find(What:="*", _
After:=ws.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False)
If rng Is Nothing Then
LastCol = 1
Else
LastCol = rng.Column
End If
Debug.Print LastCol
End Sub
To get the last column of a particular row, say row 1 use this
Debug.Print ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
Where ws is your relevant worksheet.
Similarly for Row see this.
I found that some of the answers didn't work for my worksheet that had a few rows at the end that were shorter than the others in the worksheet. The code provided just gives the last column of the last row of the worksheet. Instead, I used a loop around code to find the last column in a row, using the Find example to get the last row in the workbook.
Sub Sample()
Dim ws As Worksheet
Dim CurrRow, RowLastCol, LastRow, LastCol As Long
Set ws = Sheets("Sheet1")
'~~> This check is required else .FIND will give you error on an empty sheet
If Application.WorksheetFunction.CountA(ws.Cells) = 0 Then
LastCol = 1
Else
LastCol = 0
LastRow = ws.Cells.Find(What:="*", _
After:=ws.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
' Loop through all the rows of the sheet saving off the highest column count
For CurrRow = 1 to LastRow
RowLastCol = ws.Cells(CurrRow, Columns.Count).End(xlToLeft).Column
If RowLastCol > LastCol Then
LastCol = RowLastCol
End If
Next CurrRow
End If
Debug.Print LastCol
End Sub