How to delete the last cell in a column that contains data - vba

This sounds like a very basic question (and it is), but I cannot figure it out and I cannot find a suitable solution on the web.
How do you select the last cell in a column that contains a numeric value and delete it?
I have formulas that go past this cell and return blank values in the column. This is what is tripping me up at the moment. My current code will go all the way down to where I have carried the formulas to and start deleting those cells instead of deleting the last cell with a numeric value.
My current code looks like this
Range("AA1500").End(xlUp).Select
With Selection.Delete
End With
Any help would be greatly appreciated.
Please let me know if I can clarify anything.
Thanks

If you want to go down past cells with arbitrary strings in them and
delete the last numeric value (but not the last cell with a alphanumeric string in it), this should work:
Sub deleteLastNum()
Dim row As Integer
row = Range("A1000").End(xlUp).row
For i = row To 1 Step -1:
If IsNumeric(Cells(i, "A")) Then
Cells(i, "A").Clear
Range("A" & CStr(i + 1), "A" & CStr(row)).Cut Destination:=Range("A" & CStr(i))
Exit For
End If
Next
End Sub
It will also delete the last cell with a formula that evaluates to a number. It moves down the range of cells in the column above it with characters in it to fill in the cleared cell.

What you can do is get the total number of rows of a column (A) then check is last cell value is numeric or not, if numeric then clear that cell.
Sub del()
Dim sh As Worksheet
Dim rn As Range
Set sh = ThisWorkbook.Sheets("Sheet1")
Dim k As Long
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
If IsNumeric(Sheets("Sheet1").Range("A" & k).Value) = True Then
Sheets("Sheet1").Range("A" & k).ClearContents
End If
End Sub
This will check last cell for numeric value in column A.
Hope this is what you are asking.
EDIT
Implementing above for all the sheets in a workbook using a loop is like :
Sub del()
Dim sh As Worksheet
Dim rn As Range
For Each sh In ActiveWorkbook.Worksheets
Set sh = ThisWorkbook.Sheets(sh.Name)
Dim k As Long
Set rn = sh.UsedRange
k = rn.Rows.Count + rn.Row - 1
If IsNumeric(sh.Range("A" & k).Value) = True Then
sh.Range("A" & k).ClearContents
End If
Next sh
End Sub
This will loop through each sheet like Sheet1, Sheet2 or whatever the name of the sheet may be and check for numeric value in last cell of col A, if found numeric then it will delete the value.

You already got an answer to your post, just to be clear, the safest way to find the last row (let's say in Column "AA", according to your post), and ignoring blank cells in the middle, is by using the syntax below:
Sub FindlastRow()
Dim LastRow As Long
With Worksheets("Sheet1") ' <-- change "Sheet1" to your sheet's name
LastRow = .Cells(.Rows.Count, "AA").End(xlUp).Row
' rest of your coding here
End With
End Sub
Screen-shot of the result:

Use 'SpecialCells()'
Sub ClearLastNumber(sh As WorkSheet, columnIndex As String)
On Error GoTo ExitSub 'should 'columnIndex' column of 'sh' worksheet contain no numbers then the subsequent statement would throw an error
With sh.Columns(columnIndex).SpecialCells(xlCellTypeConstants, xlNumbers)
With .Areas(.Areas.Count)
.Cells(.Count).ClearContents
End With
End With
ExitSub:
End Sub
To be used in your "main" sub as follows
Sub Main()
Dim sh As Worksheet
For Each sh In ActiveWorkbook.Worksheets
ClearLastNumber Sh "A"
Next
End Sub

Related

Fill Empty Blank Cells with value within a region horizontaly defined

I'm trying to fill blank cells in a certain region with 0. The reagion should be defined in the current workbook but in sheet2 (not the current sheet). Also the place where it is supposed to fill is between columns
BU:CQ in the current region (not all 100 000 000 lines). Just the number of lines that define the table between columns BU and CQ. I know the problem lies in defining the region... See the code below.
What is missing?
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
InputValue = "0"
For Each cell In ThisWorkbook.Sheets("Sheet2").Range(BU).CurrentRegion
'.Cells(Rows.Count, 2).End(xlUp).Row
If IsEmpty(cell) Then
cell.Value = InputValue
End If
Next
End Sub
I've this code that i'm positive that works! But i don't wnat selection! I want somthing that specifies the sheet and a fixed range.
Now my idea is to replace "selection" with the desired range. - In this case in particular the range should be 1 - between BU:CQ; 2 - starting at row 2; 3 - working the way down until last row (not empty = end of the table that goes from column A to DE)
Sub FillEmptyBlankCellWithValue()
Dim cell As Range
Dim InputValue As String
On Error Resume Next
For Each cell In Selection
If IsEmpty(cell) Then
cell.Value = "0"
End If
Next
End Sub'
PS: And I also need to specify the sheet, since the button that will execute the code will be in the same workbook but not in the same sheet.
Use SpecialsCells:
On Error Resume Next 'for the case the range would be all filled
With ws
Intersect(.UsedRange, .Range("BU:CQ")).SpecialCells(xlCellTypeBlanks).Value = 0
End With
On Error GoTo 0
MUCH faster than looping !
Try using cells() references, such as:
For i = cells(1,"BU").Column to cells(1,"CQ").Column
cells(1,i).value = "Moo"
Next i
In your current code you list Range(BU) which is not appropriate syntax. Note that Range() can be used for named ranges, e.g., Range("TheseCells"), but the actual cell references are written as Range("A1"), etc. For Cell(), you would use Cells(row,col).
Edit1
With if statement, with second loop:
Dim i as long, j as long, lr as long
lr = cells(rows.count,1).end(xlup).row
For i = 2 to lr 'assumes headers in row 1
For j = cells(1,"BU").Column to cells(1,"CQ").Column
If cells(i,j).value = "" then cells(i,j).value = "Moo"
Next j
Next i
First off, you should reference the worksheet you're working with using:
Set ws = Excel.Application.ThisWorkbook.Worksheets(MyWorksheetName)
Otherwise VBA is going to choose the worksheet for you, and it may or may not be the worksheet you want to work with.
And then use it to specify ranges on specific worksheets such as ws.Range or ws.Cells. This is a much better method for specifying which worksheet you're working on.
Now for your question:
I would reference the range using the following syntax:
Dim MyRange As Range
Set MyRange = ws.Range("BU:CQ")
I would iterate through the range like so:
Edit: I tested this and it works. Obviously you will want to change the range and worksheet reference; I assume you're competent enough to do this yourself. I didn't make a variable for my worksheet because another way to reference a worksheet is to use the worksheet's (Name) property in the property window, which you can set to whatever you want; this is a free, global variable.
Where I defined testWS in the properties window:
Public Sub test()
Dim MyRange As Range
Dim tblHeight As Long
Dim tblLength As Long
Dim offsetLen As Long
Dim i As Long
Dim j As Long
With testWS
'set this this to your "BU:CQ" range
Set MyRange = .Range("P:W")
'set this to "A:BU" to get the offset from A to BU
offsetLen = .Range("A:P").Columns.Count - 1
'set this to your "A" range
tblHeight = .Range("P" & .Rows.Count).End(xlUp).Row
tblLength = MyRange.Columns.Count
End With
'iterate through the number of rows
For i = 1 To tblHeight
'iterate through the number of columns
For j = 1 To tblLength
If IsEmpty(testWS.Cells(i, offsetLen + j).Value) Then
testWS.Cells(i, offsetLen + j).Value = 0
End If
Next
Next
End Sub
Before:
After (I stopped it early, so it didn't go through all the rows in the file):
If there's a better way to do this, then let me know.

How to fix Compile Error: Sub or function not defined in VBA?

This is a code that goes through the cells in column B in sheet2. If it finds a value that is not a date in column B, then it copies it, pastes it another sheet called 'errors' and then deletes that row from Sheet2. Whenever I try to run this, however, I get a 'Compile Error: Sub or function not defined'. I saw some other posts on this, but nothing mentioned there seemed to work for me.
Sub removeerrors()
Dim i As Range
Dim x As Double
x = Worksheet("Errors").CountA("A1:A100")
For Each i In Worksheet("Sheet2").Range(Range("A2"), Range("A2").End(xlDown))
If IsDate(i.Offset(0, 1)) = False Then
Range(i, i.End(xlToRight)).Copy
Worksheet("Errors").Range("A1").Offset(x, 0).Paste
Range(i).EntireRow.Delete
End If
Next i
End Sub
There are a few other errors/changes that could be made within the script
Add s to Worksheet
Use Option Explicit at top of code
Application.WorksheetFunction.CountA
Add range as argument to Counta i.e. Application.WorksheetFunction.CountA(Worksheets("Errors").Range("A1:A100"))
Ensure correct ranges being worked with by wrapping in With Worksheets("Sheet2")
Determine last row by coming up from bottom of sheet with .Cells(.Rows.Count, "A").End(xlUp).Row, or you could end up looping to bottom of sheet
Correct syntax for delete line: i.EntireRow.Delete
You can put copy paste on one line: .Range(i, i.End(xlToRight)).Copy Worksheets("Errors").Range("A1").Offset(x, 0)
Be wary of using End(xlToRight) in cases of potentially ending up at far right of sheet.
Optimize code by switching some things off e.g. prevent repaint by switching off screen-updating during looping
Gather ranges to delete with Union and delete in 1 go or loop backwards to delete
VBA:
Option Explicit
Public Sub removeerrors()
Dim i As Range, x As Double, loopRange As Range, lastRow As Long, unionRng As Range
x = Application.WorksheetFunction.CountA(Worksheets("Errors").Range("A1:A100"))
Application.ScreenUpdating = False
With Worksheets("Sheet2")
lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
Set loopRange = .Range("A2:A" & lastRow)
If lastRow = 1 Then Exit Sub
For Each i In loopRange
If Not IsDate(i.Offset(0, 1)) Then
.Range(i, i.End(xlToRight)).Copy Worksheets("Errors").Range("A1").Offset(x, 0)
If Not unionRng Is Nothing Then
Set unionRng = Union(unionRng, i)
Else
Set unionRng = i
End If
End If
Next i
End With
If Not unionRng Is Nothing Then unionRng.EntireRow.Delete
Application.ScreenUpdating = True
End Sub
You just need to change Worksheet to Worksheets with 's' at the end.
Sub removeerrors()
Dim i As Range
Dim x As Double
x = Worksheets("Errors").CountA("A1:A100")
For Each i In Worksheets("Sheet2").Range(Range("A2"), Range("A2").End(xlDown))
If IsDate(i.Offset(0, 1)) = False Then
Range(i, i.End(xlToRight)).Copy
Worksheets("Errors").Range("A1").Offset(x, 0).Paste
Range(i).EntireRow.Delete
End If
Next i
End Sub
use fully qualified range references
loop backwards when deleting rows
update target sheet pasting row index
as follows
Option Explicit
Sub removeerrors()
Dim iRow As Long
Dim x As Double
x = Worksheets("Errors").CountA("A1:A100")
With Worksheets("Sheet2") ' referecne "Sheet2" sheet
With .Range(.Range("A2"), .Range("A2").End(xlDown)) ' reference referenced sheet range from cell A2 down to next not empty one
For iRow = .Rows.Count To 1 Step -1 ' loop reference range backwards from its last row up
If Not IsDate(.Cells(iRow, 2)) Then ' if referenced range cell in column B current row is not a date
.Range(.Cells(iRow, 1), .Cells(iRow, 1).End(xlToRight)).Copy Destination:=Worksheets("Errors").Range("A1").Offset(x, 0) ' copy referenced range current row spanning from column A to next not empty column and paste it to sheet "Errors" column A row x
x = x + 1 ' update offset
.Rows(1).EntireRow.Delete ' delete referenced range current row
End If
Next
End With
End With
End Sub

How can I write a Macro to sum a Column that has #N/A values in it?

I am looking to create a macro that sums a column that will always contain a few #N/A values, the number of cells in the column will change daily and so will the position of the #N/A values.
I also want to put the result in the first empty cell below that last value i.e. the first empty cell at the bottom of the column.
This is as far as I could get:
Option Explicit
Sub Total()
'
' Total Macro
Dim rg As Range
Dim Cell As Range, Target As Range
Set Target = Range("D65536").End(xlUp)
For Each Cell In Target
Cell.Errors(xlEvaluateToError).Ignore = True
Set rg = Range("D65536").End(xlUp)
rg.Offset(1, 0).Value = "=sumif(D1:D100 " <> 0 & rg.Row & ")"
Range("D65536").End(xlUp).Select
Selection.Font.Bold = True
Next
End Sub
Im using D1:D100 but only because 100 will cover the amount of cells in my Column. This is giving a strange result of more #N/As followed by a True. I dont think I should be trying to use a formula within the code.
Thanks
I would loop through and check if the value is numeric then add it to the total:
Sub mysum()
Dim lstRow As Long
Dim ws As Worksheet
Dim i As Long
Set ws = Worksheets("Sheet5") 'Change to your sheet
With ws
lstRow = .Cells(.Rows.Count, 4).End(xlUp).Row
For i = 1 To lstRow
If IsNumeric(.Cells(i, 4)) Then
.Cells(lstRow + 1, 4) = .Cells(lstRow + 1, 4) + .Cells(i, 4)
End If
Next i
End With
End Sub
You could use SpecialCells():
Sub total()
With Worksheets("SheetName") '<--| Change to your actual sheet name
With .Range("D1", .Cells(.Rows.Count, 4).End(xlUp))
.Cells(.Rows.Count,1).Offset(1).Value = WorksheetFunction.Sum(.SpecialCells(xlCellTypeConstants, xlNumbers))
End With
End With
End Sub

Using VBA, how do I select cells in a column until I hit a set string

I am new to VBA and am looking to write a dynamic VBA macro to start in a specified column, and highlight each cell in that column incrementally until I reach a cell containing the word "NULL". I don't however want to select the cell containing "NULL".
Is there any anyone that could provide a simple to follow VBA script to do this?
Lets say my data is on day 1:
ColumnHeading
123
NULL
And then on day 2:
ColumnHeading
123
13
16
NULL
Either of the below should work. If you have "Null" many times in a column, you'll need to tweak a little, as I mention.
Sub t2()
Dim nullCell As Range
Set nullCell = Columns("A").Find(what:="Null")
Debug.Print nullCell.Address
'If "Null" can appear many times, and the cell with the highest row number is the one you want, use this (uncomment out to use):
'Set nullCell = Columns("A").Find(what:="Null", Searchdirection:=xlPrevious)
'Debug.Print nullCell.Address
End Sub
(Assumes your column A has the list)
You can put this coding in workbook open events
dim I as integer
I=sheet1.range("A").end(xldown).row
sheet1.range("A"&i+1).value="NULL"
The code below will loop through all Columns with Data, and per Column will search the row where "NULL" is found, and then set Rng for the current Column.
Option Explicit
Sub FindNull()
Dim LastColumn As Long
Dim Col As Long
Dim NullCell As Range
Dim Rng As Range
' modify to your sheet name
With Worksheets("Sheet1")
' let's say your data starts from row 2
LastColumn = .Cells(2, .Columns.Count).End(xlToLeft).Column
' starting from Col "A" >> modify to your start Column
For Col = 1 To LastColumn
Set NullCell = Columns(Col).Find(what:="Null")
' for debug : print address of "NULL" and Row (per Column)
Debug.Print NullCell.Address & " ; " & NullCell.Row
' set Rng for Curren Column
Set Rng = Range(Cells(2, Col), Cells(NullCell.Row - 1, Col))
' for debug : print address current's column's Range
Debug.Print Rng.Address
' do your stuff with the Rng found per column
Next Col
End With
End Sub

Loop paste formula until next cell in range is empty

I am trying to paste a formula next to range of cells, but only the one's that contains a value, the script must loop until the next cell in the range is empty. For instance Sheet 1 Column A contains date until row 12, then I would like to paste a formula in column D2:D12 Regards
Like this?
Option Explicit
Sub Sample()
Dim lastRow As Long, i As Long
Dim ws As Worksheet
Set ws = Sheets("Sheet1")
lastRow = ws.Range("A" & Rows.Count).End(xlUp).Row
With ws
For i = 1 To lastRow
If Len(Trim(.Range("A" & i).Value)) <> 0 Then _
.Range("D" & i).Formula = "YOUR FORMULA"
Next i
End With
End Sub
As you are looking down to the first blank cell then you can avoid a loop and use
The code includes a test to make sure that the code doesn't proceed if all of column A is blank - ie if the range from A1 down extends to the bottom of the sheet and A1 is blank
This code adds a sample formula linking each cell in column D to the respective row in column B
Sub FillData()
Dim rng1 As Range
Set rng1 = Range([a1], [a1].End(xlDown))
If Not (rng1.Rows.Count = Rows.Count And Len([a1].Value) = 0) Then rng1.Offset(0, 3).FormulaR1C1 = "=RC2"
End Sub
I like Sid's beginning, but once you have the range of rows, you can insert the formula into column D all at once, without looping, several ways, here's one:
Option Explicit
Sub AddFormula()
Dim LR As Long
LR = Range("A" & Row.Count).End(xlUp).Row
Range("D2:D12").Formula = "=A2 + 7" 'just an example of a formula
End Sub
Try this:
Range("A:A").SpecialCells(2).Areas(1).Offset(, 3).Formula = "MyFormula"
This is a simple solution that is built into Excel, as long as you don't want to copy to the first blank, jump over the blank, then continue copying:
Enter the formula in the first cell of your range, and as long as it is in the column directly to the right or left of your range of filled cells, simply double-click the black box handler in the bottom right-hand corner of the cell. That will automatically copy your formula down to the last non-empty cell of the range.