I've written the following code where i want to find the value "BEST Cards Raised:" in column B and where ever this value is delete this and all subsequent rows with data in column B.
I thought what i've written would work but its currently deleting all rows and I cant figure it out :(
Dim lastRow As Long, found As Range
With ActiveSheet
Set found = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Find("BEST Cards Raised:")
If Not found Is Nothing Then
lastRow = .Cells.Find(What:="*", _
After:=.Cells(1, 1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
If lastRow >= found.Row Then
Debug.Print .Rows(found.Row & ":" & lastRow).EntireRow.Delete
End If
End If
End With
If also deleting the row where found then perhaps try the following:
Option Explicit
Public Sub DeleteRows()
Dim lastRow As Long, found As Range
With ThisWorkbook.Worksheets("Sheet1") '<your sheet
Set found = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row).Find("BEST Cards Raised:")
If Not found Is Nothing Then
lastRow = .Cells.Find(What:="*", _
After:=.Cells(1, 1), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
If lastRow >= found.Row Then
.Rows(found.Row & ":" & lastRow).EntireRow.Delete
End If
End If
End With
End Sub
Post debugging
Dim lastRow As Long, foundRow As Variant
With ThisWorkbook.Worksheets("Sheet8")
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
foundRow = Application.Match("BEST Cards Raised:", .Range("B1:B" & lastRow), 0)
If IsError(foundRow) Then Exit Sub
If lastRow >= foundRow Then .Rows(foundRow & ":" & lastRow).EntireRow.Delete
End With
Try this (comments in code):
Sub DeleteRows()
Dim ws As Worksheet, lastRow As Long, i As Long, j As Long
Set ws = ThisWorkbook.Worksheets("Sheet1")
lastRow = ws.Cells(ws.Rows.Count, 2).End(xlUp).Row
'determine where to start deleting rows
For i = 1 To lastRow
If Trim(ws.Cells(i, 2).Value) = "BEST Cards Raised:" Then Exit For
Next
'delete all rows from last to found row, looping backwards
For j = lastRow To i Step -1
ws.Rows(j).Delete
Next
End Sub
Related
I need to manipulate an Excel worksheet in code using MS Access and need to find the last used column in my opened Excel file. I would also need to find the last used row in a column.
Here are functions I am using:
Public Function FindLastColumnInWSheet(ws As Worksheet) As Long
Dim LastCol As Long
Dim rng As Range
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
FindLastColumnInWSheet = LastCol
End Function
Public Function FindLastRowInColumn(wsheet As Worksheet, columnName As String) As Integer
With wsheet
FindLastRowInColumn = .Range(columnName & .rows.Count).End(xlUp).row
End With
End Function
I have been using this syntax to add a total row to one worksheet
With ActiveSheet
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
Else
LastRow = 1
End If
End With
Range("C" & LastRow + 1).FormulaR1C1 = "=SUM(R[-" & LastRow & "]C:R[-1]C)"
Range("C" & LastRow + 1 & ":L" & LastRow + 1).FillRight
I thought to add it to all worksheets in the workbook, I would just need to add a foreach loop like so
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
'code above
Next
But that did not fit the bill as since I use With ActiveSheet it just adds multiple "Total" rows to the selected worksheet.
How can I add a total row to each worksheet in my workbook?
Try this. I did not tested it. you test the code and let me know if there are errors, i will then work on it -
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
With ws
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
Else
LastRow = 1
End If
End With
ws.Range("C" & LastRow + 1).FormulaR1C1 = "=SUM(R[-" & LastRow & "]C:R[-1]C)"
ws.Range("C" & LastRow + 1 & ":L" & LastRow + 1).FillRight
Next
You just need to make sure that you are activating each worksheet:
Dim ws As Worksheet
For Each ws In ActiveWorkbook.Worksheets
ws.activate
'code above
Next
should do it.
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
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
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