Update an Empty Cell in a range - excel

I'm looking to update a cell on a sheet when it's left empty. If there is data in column B but not in column AA, I need to insert something into column AA.
I have made the following code but have failed to make it update the cell:
Range("B2").Select
Do Until IsEmpty(ActiveCell)
Dim LoopRowNo As Integer
LoopRowNo = ActiveCell.Row
If IsEmpty(Range(Cells(LoopRowNo, 26))) Then Range(Cells(LoopRowNo, 26)).Value = "01/01/1990"
ActiveCell.Offset(1, 0).Select
Loop
Hoping someone can point me in the right direction.

Use Range or Cells, but not both.
Don't Select.
With ActiveSheet
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
Dim i As Long
For i = 2 to lastRow
If IsEmpty(.Cells(i, "AA")) And Not IsEmpty(.Cells(i, "B")) Then
.Cells(i, "AA").Value = "01/01/1990"
End If
Next
End With

Related

Delete Cell based off another Cell that is a date

Working in Excel VBA.
I'm trying to delete a cell, if there is a date in another cell via VBA.
Or another way to put it, I'm trying to delete a cell, if another cell has ANYthing in it. (As it's either a date, or not.)
Here's my code - I just don't know how to recognise any date in the cell.
Sub Upload1ClearADP()
Dim LastRow As Long, x As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To LastRow
If Cells(x, "G").Value = "Date" Then
Cells(x, "U").ClearContents
End If
Next x
End Sub
You're currently checking for a string Date, not technically an actual date.
Here's your code written to check if it's a date OR is empty:
Sub Upload1ClearADP()
Dim LastRow As Long, x As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To LastRow
If IsDate(Cells(x, "G").Value) or Cells(x, "G") <> "" Then
Cells(x, "U").ClearContents
End If
Next x
End Sub
Edit: As #Harun24HR points out in the comments, the IsDate() is unnecessary, since you check if the cell is not empty (<> ""). I just wanted to put it there to introduce the IsDate() function.
Edit 2: You can also use SpecialCells() to do the clearing in one line:
Sub Upload1ClearADP()
Dim LastRow As Long
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Dim dataRng As Range
Set dataRng = Range(Cells(2, "G"), Cells(LastRow, "G"))
' Use 14 because it's 14 columns to the right from
' Column G to U
dataRng.SpecialCells(xlCellTypeConstants).Offset(0, 14).ClearContents
' If you have formulas *and* constants in column G, use:
' Union(dataRng.SpecialCells(xlCellTypeConstants), _
' dataRng.SpecialCells(xlCellTypeFormulas)).Offset(0,14).ClearContents
End Sub

Excel VBA: Delete rows if value not equal to a value?

So I've been searching hard to find why my code hasn't been working, but every time I try, I get a result where nothing is changed. Can someone please tell me what I'm missing? Sorry, I'm a total novice but I'm trying.
Dim Cell As Range
With Sheets(1)
' loop column D until last cell with value (not entire column)
For Each Cell In .Range("D2:D" & .Cells(.Rows.Count, "D").End(xlUp).Row)
If Cell.Value <> 110 Then
Rows(Cell.Row).EntireRow.Delete
End If
Next Cell
End With
Instead of looping, make use of excels inbuilt functions, its cleaner and more concise.
With Sheets(1).UsedRange
.AutoFilter Field:=4, Criteria1:="<>110"
.Offset(1).SpecialCells(xlCellTypeVisible).EntireRow.Delete
.AutoFilter
End With
if you insist on looping then use the following code:
With Sheets(1).UsedRange
For lrow = .Rows.Count To 2 Step -1
If .Cells(lrow, 4).Value <> 110 Then .Rows(lrow).Delete
Next lrow
End With
Untested, but maybe something like:
Option explicit
Sub DeleteRows()
With thisworkbook.worksheets(1)
' loop column D until last cell with value (not entire column)
Dim lastRow as long
lastRow = .Cells(.Rows.Count, "D").End(xlUp).Row
Dim rowIndex as long
For rowIndex = lastRow to 2 step -1
If .cells(rowIndex, "D").value2 <> 110 then
.cells(rowIndex, "D").entirerow.delete
End if
Next rowIndex
End With
End sub
If you have a lot of rows, you could use union to build a range consisting of all rows to be deleted, then delete them in one go.

Make last cell in row active

How can I, using the code below, replace "B5" by the "LastCol" so that I can activate the last non-blank cell in a row?
Sub LastColumnInOneRow()
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
End With
Worksheets("WARNINGS").Range("B5").Activate
ActiveCell.Offset(2, 0).Activate
End Sub
Thank you
You could do like this:
Sub LastColumnInOneRow()
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
End With
With Worksheets("WARNINGS")
.Activate
.Cells(5,LastCol).Activate
End With
ActiveCell.Offset(2, 0).Activate
End Sub
The question took me a minute to figure out but try this
Worksheets("WARNINGS").Cells(6, LastCol + 1).Activate
at the end.
Sub LastColumnInOneRow()
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Long
With ActiveSheet
LastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
End With
Worksheets("WARNINGS").Cells(6, LastCol + 1).Activate
End Sub
Excellent! Many thanks. Here is the one I used at the end.
This was a first step towards sorting a pivot table results.
I saved a macro to sort the values but am now getting a "Subscript out of Range" warning when I try to run it. I guess the macro script is using a static range that I need to replace so that it can run to whatever Pivot Table results I may have.
But which line of the macro code do I need to replace?
Sub SortLargestWarningsCount()
'Find the last used column in a Row: row 1 in this example
Dim LastCol As Integer
With ActiveSheet
LastCol = .Cells(6, .Columns.Count).End(xlToLeft).Column
End With
Worksheets("WARNINGS").Cells(6, LastCol).Activate
ActiveCell.Offset(1, 0).Activate
'Sort from Largest
ActiveSheet.PivotTables("WarningsPivotTable").PivotFields( _
"[Warnings].[Column5].[Column5]").AutoSort xlDescending, _
"[Measures].[Count of Column5]", ActiveSheet.PivotTables("WarningsPivotTable"). _
PivotColumnAxis.PivotLines(12), 1
End Sub

Copying a formula down through x number of rows

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

Select only cells with data but skip the first cell in a column

I am currently using this script.
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
For Each xCell In Selection
xCell.Value = CDec(xCell.Value)
Next xCell
I want to only select the cells in column E that have data, but the amount of cells that have data varies, and I don't want to select E1 because it has a header. This code changes the foreign text in column E to numbers that I can actually use the sum function to add up. The way it is written now it puts a 0 in all of the cells in the column infinitely.
Try following code:
Dim lastrow As Long
lastrow = Application.Max(2, Cells(Rows.Count, "E").End(xlUp).Row)
With Range("E2:E" & lastrow)
.NumberFormat = "0"
.Value = .Value
End With
UPD:
if it doesn't help, try this:
Dim lastrow As Long
lastrow = Application.Max(2, Cells(Rows.Count, "E").End(xlUp).Row)
For i = 2 To lastrow
With Range("E" & i)
.Value = CDec(.Value)
End With
Next

Resources