Delete empty rows using VBA - MS Excel - vba

I am looking to see if there is a more efficient way to achieve the result below, so it can be extended if needed.
I'm using this to clean up large spreadsheets that have the rows C-Z blank. I imagine there should be a way to clean it up so that it doesn't have to double in size if I need to clean up a spreadsheet with data from C to AZ.
It's been a while since I used VBA, I found the code below online. (counting ROW B as the spreadsheet in question had an empty ROW A)
Sub delem()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
For r = lr To 1 Step -1
If Range("C" & r).Value = "" And Range("D" & r).Value = "" And Range("E" & r).Value = "" And Range("F" & r).Value = "" And Range("G" & r).Value = "" And Range("H" & r).Value = "" And Range("I" & r).Value = "" And Range("J" & r).Value = "" And Range("K" & r).Value = "" And Range("L" & r).Value = "" And Range("M" & r).Value = "" And Range("N" & r).Value = "" And Range("O" & r).Value = "" And Range("P" & r).Value = "" And Range("Q" & r).Value = "" And Range("R" & r).Value = "" And Range("S" & r).Value = "" And Range("T" & r).Value = "" And Range("U" & r).Value = "" And Range("V" & r).Value = "" And Range("W" & r).Value = "" And Range("X" & r).Value = "" And Range("Y" & r).Value = "" And Range("Z" & r).Value = "" Then Rows(r).Delete
Next r
End Sub
Thanks!

Just add an inner loop to go through the columns you care about. This will actually run much faster, as VBA doesn't short-circuit the If statement (all of the conditionals are evaluated). But with the loop, you can exit early if you find a value anywhere:
Sub delem()
Dim last As Long
Dim current As Long
Dim col As Long
Dim retain As Boolean
last = Cells(Rows.Count, "B").End(xlUp).Row
For current = last To 1 Step -1
retain = False
For col = 3 To 26
If Cells(current, col).Value <> vbNullString Then
retain = True
Exit For
End If
Next col
If Not retain Then Rows(current).Delete
Next current
End Sub

The Excel worksheet function COUNTA is a clean way to test if a range is empty.
Sub delem()
Dim lr As Long, r As Long
lr = Cells(Rows.Count, "B").End(xlUp).Row
For r = lr To 1 Step -1
'This function Counts the number of cells that are not empty
If WorksheetFunction.CountA(Range(Cells(r, 3), Cells(r, 26)) = 0 Then
Rows(r).Delete
End If
Next r
End Sub

Related

VBA Code to Check one Column Data with Multiple Columns Data?

I have id numbers on column A starts from A3 To A25. I want to check each of the column A value with the F G H I columns values. In F G H I columns where data starts from 29th-row, how do check with A column value with multiple columns values at a time?
lastrow = Range("A" & Rows.Count).End(xlUp).Row
lastrow1 = Range("F" & Rows.Count).End(xlUp).Row
For i = 3 To lastrow
For j = 30 To lastrow1
If Range("F" & j).Value = Range("A" & i).Value Or Range("G" & j).Value = Range("A" & i).Value Or Range("H" & j).Value = Range("A" & i).Value Or Range("I" & j).Value = Range("A" & i).Value Then
End if
Next j
Next i
use below code. i have tested on your query
Please test it if any problem, feel free to contact.
Function allvlookup(rng As Range, rng1 As Range)
Dim rng_r As Range
Dim str As String
For Each rng_r In rng1
If rng = rng_r Then
result = rng_r.Value
End If
Next rng_r
allvlookup = result
End Function

Highlight cells based on cell content with Excel VBA

This is for an Microsoft Excel VBA macro. What it is supposed to do, for every row, when "Late" is entered into column C, to highlight the cell 2 spaces to the left and Range of cells 3 spaces to the right through 43. So example is C4 contains "Late", highlight A4 and F4:AW4. Same goes for the word "Hold" just a different color.
Private Sub Highlight_Condition(ByVal Target As Range)
Dim lastRow As Long
Dim cell As Range
Dim i As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Application.EnableEvents = False
For i = lastRow To 1 Step -1
If .Range("C" & i).Value = "LATE" Then
Debug.Print "Checking Row: " & i
.Range("A" & i).Interior.ColorIndex = 39
.Range("F" & i & ":AW" & i).Interior.ColorIndex = 39
ElseIf .Range("C" & i).Value = "HOLD" Then
.Range("A" & i).Interior.ColorIndex = 43
.Range("F" & i & ":AW" & i).Interior.ColorIndex = 43
Else
.Range("A" & i & ":AW" & i).ClearContents
.Range("F" & i & ":AW" & i).ClearContents
End If
Next i
Application.EnableEvents = True
End With
End Sub
This should work for you...
Private Sub Highlight_Condition(ByVal Target As Range)
Dim lastRow As Long
Dim cell As Range
Dim i As Long
With ActiveSheet
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Application.EnableEvents = False
For i = lastRow To 1 Step -1
If .Range("C" & i).Value = "LATE" Then
Debug.Print "Checking Row: " & i
.Range("A" & i).Interior.ColorIndex = 39
.Range("F" & i & ":AW" & i).Interior.ColorIndex = 39
ElseIf .Range("C" & i).Value = "HOLD" Then
.Range("A" & i).Interior.ColorIndex = 43
.Range("F" & i & ":AW" & i).Interior.ColorIndex = 43
Else
.Range("A" & i & ":AW" & i).ClearContents
.Range("F" & i & ":AW" & i).ClearContents
End If
Next i
Application.EnableEvents = True
End With
End Sub
Tested and seems to work fine for me :)
... C4 contains "Late" ... (emphasis mine)
This seems to indicate that Late may be part of a longer string. I will code to that effect.
Conditional formatting rules are a quick method of achieving your cell highlighting and respond as soon as values in column C change without rerunning the sub procedure (unless more values are added below the lastRow).
Option Explicit
Sub Macro1()
Const TEST_COLUMN As String = "D"
Dim lastRow As Long, sSheetName As String
sSheetName = ActiveSheet.Name
With Worksheets(sSheetName)
lastRow = .Cells(.Rows.Count, TEST_COLUMN).End(xlUp).Row
With .Range("A4:A" & lastRow & ", F4:AW" & lastRow)
.FormatConditions.Delete
.FormatConditions.Add Type:=xlExpression, Formula1:="=isnumber(search(""late"", $c4))"
.FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 39
.FormatConditions.Add Type:=xlExpression, Formula1:="=isnumber(search(""hold"", $c4))"
.FormatConditions(.FormatConditions.Count).Interior.ColorIndex = 43
End With
End With
End Sub
Great! I wanted to run this in the worksheet and not as a module. So i added a few extra lines and ByVal Target As Range to fire everytime a change is made in the range but it doesn't seem to work. Am i missing something?
Private Sub Highlight_Condition(ByVal Target As Range)
Dim LastRow As Long
Dim cell As Range
Dim i As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Application.EnableEvents = False
For i = LastRow To 1 Step -1
If .Range("C" & i).Value = "LATE" Then
Debug.Print "Checking Row: " & i
.Range("A" & i).Interior.ColorIndex = 39
.Range("F" & i & ":AW" & i).Interior.ColorIndex = 39
ElseIf .Range("C" & i).Value = "HOLD" Then
.Range("A" & i).Interior.ColorIndex = 43
.Range("F" & i & ":AW" & i).Interior.ColorIndex = 43
Else
.Range("A" & i).EntireRow.Interior.ColorIndex = xlNone
End If
Next i
Application.EnableEvents = True
End With
End Sub

VBA Code, but need to keep rows with no data

I am using VBA to delete rows that do not meet a certain criteria. The code is working, however, I can't figure out how to keep the blank rows separating the data. Below is the code I'm using. It works well for deleting what I want it to, however, it also is deleting the blank lines in between.
Sub DeleteRows()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Long
For i = Range("E" & Rows.Count).End(xlUp).Row To 1 Step -1
If (Range("E" & i).Value > -5 And Range("E" & i).Value < 5) Then
Range("E" & i).EntireRow.Delete
Else
If (Range("D" & i).Value > -500 And Range("D" & i).Value < 500) Then
Range("D" & i).EntireRow.Delete
End If
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Thanks!
I think it should be enough to check for blank spaces and if a cell is blank, do not delete that row. Like this
Sub DeleteRows()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Dim i As Long
For i = Range("E" & Rows.Count).End(xlUp).Row To 1 Step -1
If (Range("E" & i).Value > -5 And Range("E" & i).Value < 5 and Range("E" & i) <> "") Then
Range("E" & i).EntireRow.Delete
Else
If (Range("D" & i).Value > -500 And Range("D" & i).Value < 500 and Range("D" & i) <> "") Then
Range("D" & i).EntireRow.Delete
End If
End If
Next i
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Adding another And statement should do the trick for example you can use <> to say Does Not Equal.
If (Range("E" & i).Value > -5 And Range("E" & i).Value < 5) And Range("E" & i).Value <> "" Then

VBA in Excel returning Type mismatch

I'm trying to create a Macro that will modify contents in columns S, W and AH based on the content in AB
e.g. if AB1 = No, then S1=C-MEM, AH = N/A and W is cleared.
For some reason, I get a 'Type mismatch' error on the first line of my if statement and can't figure out why or how to fix it - even after reading other posts about similar issue.
Sub test()
Dim lastrow As Long
Dim i As Long
lastrow = Range("AB" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
**-> If Range("AB" & i).Value = "No" Then
Range("S" & i).Value = "C-MEM"
Range("W" & i).Value = ""
Range("AH" & i).Value = "N/A"
End If
Next i
End Sub
Thanks
You are trying to test if an error is = No.
Test for the error and skip the logic in that loop:
Sub test()
Dim lastrow As Long
Dim i As Long
lastrow = Range("AB" & Rows.Count).End(xlUp).Row
For i = 2 To lastrow
If Not IsError(Range("AB" & i).Value) Then
If Range("AB" & i).Value = "No" Then
Range("S" & i).Value = "C-MEM"
Range("W" & i).Value = ""
Range("AH" & i).Value = "N/A"
End If
End If
Next i
End Sub

How to do a 3-part IF statement in VBA?

'8
If Not IsEmpty(Range("A7")) And Range("C7") = "\" Then
Range("W7") = "\"
ElseIf Not IsEmpty(Range("A7")) And Range("C7") <> "\" Then
Range("W7") = "\L"
ElseIf IsEmpty(Range("A7")) Then
Range("W7") = ""
End If
With Sheets("DL Data")
.Range("W7:W" & .Cells(.Rows.Count, "A").End(xlUp).Row).Formula = "\L"
End With
I cannot seem to figure out the WITH part, or maybe I am off on the IF statement all together. What I am trying to do here is this:
IF A7 is not empty AND it equals "\" THEN W7 equals "\", also
IF A7 is not empty AND it does not equal "\" THEN W7 equals "\L", also
IF A7 is empty THEN W7 equals blank
Then I would like it to do this to search through the Column and give me the appropriate answer, inserting blanks where necessary, inserting "\" where necessary and inserting "\L" where necessary.
Hope I am making myself clear here, thanks for all of the help in advance!
Regards,
Yazz
The With is simply an abbreviation.
For example
With Sheets("DL Data")
.Range("W7:W" & .Cells(.Rows.Count, "A").End(xlUp).Row).Formula = "\L"
End With
Is equivalent to
Sheets("DL Data").Range("W7:W" & Sheets("DL Data").Cells(Sheets("DL Data").Rows.Count, "A").End(xlUp).Row).Formula = "\L"
You need a loop in order to apply this condition to all of the rows, for example:
Dim i as Integer
For i = 7 To Sheets("DL Data").Range("A7").End(xlDown).Row
If Not IsEmpty(Range("A" & i)) And Range("C" & i) = "\" Then
Range("W" & i) = "\"
ElseIf Not IsEmpty(Range("A" & i)) And Range("C" & i) <> "\" Then
Range("W" & i) = "\L"
ElseIf IsEmpty(Range("A" & i)) Then
Range("W" & i) = ""
End If
Next i
If you want to run it through the whole column, you need to nest the same If-block into a loop:
With Sheets("DL Data")
For j = 7 To .Range("A7").End(xlDown).Row
If .Range("A" & j) <> "" And .Range("C" & j) = "\" Then
.Range("W" & j) = "\"
ElseIf .Range("A" & j) <> "" And .Range("C" & j) <> "\" Then
.Range("W" & j) = "\L"
ElseIf .Range("A" & j) = "" Then
.Range("W" & j) = ""
End If
Next j
End With
WARNING I have followed your current implementation; however, if your column "A" might have some empty cells in between (which would explain the presence of a ElseIf .Range("A" & j) = ""), pay attention to the fact that the counter .Range("A7").End(xlDown).Row would stop at the first empty cell. You might want to index your counter into an always filled-up column (such as a record-ID of your data set).
This update to your code will update the W column according to your formula. I optimized the If statements a bit to make them less redundant.
Additionally, I have included a couple of With blocks for illustration purposes.
With Sheets("DL Data")
Dim row As Long
For row = 7 To .Cells(.Rows.Count, "A").End(xlUp).Row)
With .Range("A" & row)
' IF A is empty THEN W equals blank
If .Value = "" Then
Range("W" & row).Value = ""
' IF A is not empty AND it equals "\" THEN W equals "\"
If .Value = "\" Then
Range("W" & row).Value = "\"
' IF A is not empty AND it does not equal "\" THEN W equals "\L"
' A is not empty (first condition checked above).
ElseIf .Value <> "\"
Range("W" & row).Value = "\L"
End If
End With
Next
End With