excel vba select last row and last column - vba

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

Related

Highlight rows if value in column A is x

How can I highlight a single row a color if text in column A = X
Using Row 4 as an example:
What i'm ultimately trying to get is if Cell in Column A is = X then change row color from Range("B4:N4") to Black And Text.Color to White from Range("F4:N4")
Ultimately I would want it to be something like Range(Cells(i, "B"), Cells(LastRow, LastCol)) but only color one row.
This is what i am working with so far.
Sub Header()
Application.ScreenUpdating = False
Dim sht2 As Worksheet
Set sht2 = ThisWorkbook.Worksheets("Email Form")
sht2.Activate
sht2.Unprotect
Dim LastRow As Long, LastCol As Long
Dim rng As Range, c As Range
Dim WholeRng As Range
Dim i As Integer
On Error GoTo 0
With sht2
Set rng = .Cells
LastRow = rng.Find(What:="*", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
LastCol = rng.Find(What:="*", After:=rng.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
'MsgBox wholerng.Address
Set WholeRng = Range(Cells(i, "B"), Cells(LastRow, LastCol)).Rows
For i = 4 To LastRow
If sht2.Cells(i, 1).Value = "X" Then
With WholeRng
With .Interior
.PatternColorIndex = xlAutomatic
.Color = 1
.TintAndShade = 0
.Font.Color = 0
End With
End With
End If
Next i
Dim b As Boolean
For Each rng In WholeRng.Rows
If Not rng.Hidden Then
If b Then rng.Interior.Color = 1
b = Not b
End If
Next
End With
Set sht2 = Nothing
Set rng = Nothing
Set WholeRng = Nothing
Application.ScreenUpdating = False
End Sub
VBA Conditional Formatting.
Option Explicit
Sub Header()
Dim sht2 As Worksheet
Dim firstRow As Long, lastRow As Long, lastCol As Long
'Application.ScreenUpdating = false
On Error GoTo 0
Set sht2 = ThisWorkbook.Worksheets("Email Form")
firstRow = 4
With sht2
.Activate
.Unprotect
lastRow = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, SearchDirection:=xlPrevious, MatchCase:=False).Row
lastCol = .Cells.Find(What:="*", After:=.Cells(1), Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious, MatchCase:=False).Column
'black row, white text B:N
With .Range(.Cells(firstRow, "B"), .Cells(lastRow, lastCol))
'optionally remove any pre-existing CFRs
.FormatConditions.Delete
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=UPPER($A4)=CHAR(88)")
.Interior.ThemeColor = xlThemeColorLight1
.Font.ThemeColor = xlThemeColorDark1
.SetFirstPriority
.StopIfTrue = False
End With
End With
'don't display values from B:E
With .Range(.Cells(firstRow, "B"), .Cells(lastRow, "E"))
With .FormatConditions.Add(Type:=xlExpression, Formula1:="=UPPER($A4)=CHAR(88)")
.NumberFormat = ";;;"
End With
End With
'I tnhink you want to reProtect the worksheet here
.Protect
End With
Application.ScreenUpdating = True
End Sub
I think you can achieve your goal using Conditional Formatting:
You can create a condition for each format setting for the two different ranges.
Select one range at a time, then from the Home tab, create a New Conditional Formatting Rule, choose to Use a Formula and then enter a formula like:
=$A2="X"
Note that when using relative/mixed references in conditional formatting, it will be compared to the first cell in the range you are working with. I've selected range B2:N7 to apply formatting to, so the mixed reference needs to be created as it should apply to the B2 cell. You can't see it, but the reference automatically changes for all other cells in the same range, the same as if you were filling a formula across the rest of the range. For example, the formatting for the K5 cell will be dependent on the value in $A5 (because the column reference is fixed but the row reference is dynamic).
Then set the background colour or font colour you want for the range specified. This condition will check column A of the corresponding row.
I re-wrote some of your code and added comments to show you why. But by and large, I followed your original approach.
Sub Header()
Dim Sht2 As Worksheet
Dim LastRow As Long, LastCol As Long
Dim IsBlack As Boolean, FillPattern As Long
Dim Rng As Range
Dim R As Long
' Set sht2 = ThisWorkbook.Worksheets("Email Form")
Set Sht2 = ThisWorkbook.Worksheets("Taylor")
' On Error GoTo 0 ' this is the default: no need to set
Application.ScreenUpdating = False
With Sht2
.Activate ' no need to activate this sheet
.Unprotect
' this is the whole sheet: Easier to refer to it as .Cells
' Set rng = .Cells
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
LastCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
' LastRow = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, _
' LookIn:=xlFormulas, SearchOrder:=xlByRows, _
' SearchDirection:=xlPrevious, MatchCase:=False).Row
' LastCol = Rng.Find(What:="*", After:=Rng.Cells(1), Lookat:=xlPart, _
' LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
' SearchDirection:=xlPrevious, MatchCase:=False).Column
' MsgBox "Last row = " & LastRow & vbCr & _
' "Last column = " & LastCol
For R = 4 To LastRow
IsBlack = Not CBool(StrComp(.Cells(R, 1).value, "X", vbTextCompare))
FillPattern = CLng(Array(xlNone, xlSolid)(Abs(IsBlack)))
Set Rng = .Range(.Cells(R, 1), .Cells(R, LastCol))
With Rng.Interior
If .Pattern <> FillPattern Then
.Pattern = FillPattern
If IsBlack Then
.PatternColorIndex = xlAutomatic
.ThemeColor = xlThemeColorLight1
End If
.TintAndShade = 0
.PatternTintAndShade = 0
Rng.Font.ColorIndex = Array(xlAutomatic, 2)(Abs(IsBlack))
End If
End With
Next R
End With
' VBA does this cleanup automatically at the end of the sub
' Set sht2 = Nothing
' Set Rng = Nothing
Application.ScreenUpdating = False
End Sub

Paste Data with AutoFill in 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

How to select full range in excel vba

When I am debugging a excel-vba program I came to know my data range is not completely selected.
Below picture shows my data's model and my problem.
I used this code to select the whole range. But this is not working properly.
Dim rngTemp As Range
Set rngTemp = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious)
With rngTemp
Please help me by giving the code for selecting the whole range as given in the figure above.
In your code you are searching by xlByRows. And hence you are getting the address of the last cell which has data which is G7.
Further to my comment, Is this what you are trying?
Sub Sample()
Dim lastrow As Long, lastcol As Long
Dim rng As Range
With Sheets("Sheet1") '<~~ Change this to the relevant sheet
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastrow = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
lastcol = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
Else
lastrow = 1: lastcol = 1
End If
Set rng = .Range("A1:" & _
Split(.Cells(, lastcol).Address, "$")(1) & _
lastrow)
MsgBox rng.Address
End With
End Sub
PLEASE BE AWARE THAT METHOD BELOW IS NOT RELIABLE IN SOME CASES. I WILL LEAVE THIS ANSWER HERE AS A BAD EXAMPLE. FOR DETAILED INFORMATION PLEASE SEE #SiddharthRout 'S EXPLANATION IN THIS LINK
I would use following code to find used range instead of looking for "*" in the cell value:
Sub SelectRange()
Dim LastRow As Long
Dim LastColumn As Long
Dim aWB As Workbook
Dim aWS As Worksheet
Set aWB = ActiveWorkbook
Set aWS = aWB.ActiveSheet '<-You can change sheet name like aWB.sheets("SheetName")
With aWS.UsedRange
LastRow = .Rows(.Rows.Count).Row
LastColumn = .Columns(.Columns.Count).Column
End With
aWS.Range(Cells(1, 1), Cells(LastRow, LastColumn)).Select '<---Cells(1, 1) is the starting cell of range)
End Sub

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

Merge Data in Excel Range, Removing Blanks and Duplicates

I have a range of cells in Excel that is more than one column wide and more than one row long. Some of the cells are blank. I would like to merge (using VBA) the non-blank cells into a list, remove the duplicates, and sort alphabetically.
For example, given this input (where a dash designates an empty cell for the purpose of this question):
- - A D -
C - - A -
- - B - D
- - - - -
A - - E -
The following sorted output is produced:
A
B
C
D
E
As the example input shows, some of the rows and columns in the range may contain all empty cells.
Here is one way to do it.
CODE
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long, lastCol As Long, i as Long
Dim Rng As Range, aCell As Range
Dim MyCol As New Collection
'~~> Change this to the relevant sheet name
Set ws = Sheets("Sheet21")
With ws
LastRow = .Cells.Find(What:="*", After:=.Range("A1"), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
lastCol = .Cells.Find(What:="*", After:=.Range("A1"), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False).Column
Set Rng = .Range("A1:" & Split(.Cells(, lastCol).Address, "$")(1) & LastRow)
'Debug.Print Rng.Address
For Each aCell In Rng
If Not Len(Trim(aCell.Value)) = 0 Then
On Error Resume Next
MyCol.Add aCell.Value, """" & aCell.Value & """"
On Error GoTo 0
End If
Next
.Cells.ClearContents
For i = 1 To MyCol.Count
.Range("A" & i).Value = MyCol.Item(i)
Next i
'~~> OPTIONAL (In Case you want to sort the data)
.Columns(1).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End Sub
SNAPSHOTS
FOLLOWUP
I just realized that adding 3 lines more makes this code even faster than the above code.
Option Explicit
Sub Sample()
Dim ws As Worksheet
Dim LastRow As Long, lastCol As Long, i As Long
Dim Rng As Range, aCell As Range, delRange As Range '<~~ Added This
Dim MyCol As New Collection
'~~> Change this to the relevant sheet name
Set ws = Sheets("Sheet1")
With ws
'~~> Get all the blank cells
Set delRange = .Cells.SpecialCells(xlCellTypeBlanks) '<~~ Added This
'~~> Delete the blank cells
If Not delRange Is Nothing Then delRange.Delete '<~~ Added This
LastRow = .Cells.Find(What:="*", After:=.Range("A1"), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, MatchCase:=False).Row
lastCol = .Cells.Find(What:="*", After:=.Range("A1"), _
Lookat:=xlPart, LookIn:=xlFormulas, SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, MatchCase:=False).Column
Set Rng = .Range("A1:" & Split(.Cells(, lastCol).Address, "$")(1) & LastRow)
'Debug.Print Rng.Address
For Each aCell In Rng
If Not Len(Trim(aCell.Value)) = 0 Then
On Error Resume Next
MyCol.Add aCell.Value, """" & aCell.Value & """"
On Error GoTo 0
End If
Next
.Cells.ClearContents
For i = 1 To MyCol.Count
.Range("A" & i).Value = MyCol.Item(i)
Next i
'~~> OPTIONAL (In Case you want to sort the data)
.Columns(1).Sort Key1:=.Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
DataOption1:=xlSortNormal
End With
End Sub