With the following code I loop through a range of about 200 cells [Range("R" & i)] to check if the Temp_Sheet.Range("B2") value is within the range. This code below works great.
Here's the problem: If the loop completes and doesn't find the value within the range, I need the B2 value added to the next blank row. How would I go about doing this? Thanks in advance for the help. Can I add formatting within the loop that will trigger another sub/function if no value is found?
For i = 6 To ColarLastRow
If ChangeSheet.Range("R" & i).Value = Temp_Sheet.Range("B2") Then
ChangeSheet.Range("G" & i) = Sum_Range
ChangeSheet.Range("G" & i).Interior.Color = RGB(0, 100, 0)
Else: End If
Next i
You need to set some flag inside a loop:
Dim AddNew As Boolean
AddNew = True
For i = 6 To ColarLastRow
If ChangeSheet.Range("R" & i).Value = Temp_Sheet.Range("B2") Then
ChangeSheet.Range("G" & i) = Sum_Range
ChangeSheet.Range("G" & i).Interior.Color = RGB(0, 100, 0)
AddNew = False
Else: End If
Next i
If AddNew Then
'place your code here
End If
Looks like there are already some good answers, but this is what I came up with....
Dim ChangeSheet As Worksheet
Dim Temp_Sheet As Worksheet
Dim ValueFound As Boolean
Set ChangeSheet = Sheets("ChangeSheet")
Set Temp_Sheet = Sheets("Temp_Sheet")
ColarLastRow = ChangeSheet.Cells(Rows.Count, 18).End(xlUp).Row
ValueFound = False
For i = 6 To ColarLastRow
If ChangeSheet.Range("R" & i).Value = Temp_Sheet.Range("B2") Then
ChangeSheet.Range("G" & i) = Sum_Range
ChangeSheet.Range("G" & i).Interior.Color = RGB(0, 100, 0)
ValueFound = True
Else: End If
Next i
If ValueFound = False Then
ChangeSheet.Range("R" & ColarLastRow + 1).Value = Temp_Sheet.Range("B2").Value
End If
Dim counter as Integer
counter = 0
For i = 6 To ColarLastRow
If ChangeSheet.Range("R" & i).Value = Temp_Sheet.Range("B2") Then
ChangeSheet.Range("G" & i) = Sum_Range
ChangeSheet.Range("G" & i).Interior.Color = RGB(0, 100, 0)
Counter = counter + 1
Else: End If
Next i
If counter = 0 then
ChangeSheet.Range("R" & ChangeSheet.Range("R" & ChangeSheet.Rows.Count).End(xlUp).Offset(1,0) = Temp_Sheet.Range("B2")
End If
dim Rng as Range
Set rng = ChangeSheet.Range("R6:R" & ColarLastRow).Find _
(What:=Temp_Sheet.Range("B2"), LookIn:=xlValues)
'set LookIn:=xlValues, xlFormulas, as appropriate
'set MatchCase:=True or False, as appropriate
If Rng is Nothing then
ChangeSheet.Range("R" & ColarLastRow+1).Value = 'something
'set color here
Else
ChangeSheet.Range("G" & rng.row) = Sum_Range
End if
Using the .Find will be much faster than looping through. If you need to find multiple occurrences, then after Set Rng = add this:
Set rng = ChangeSheet.Range("R6:R" & ColarLastRow).Find _
(What:=Temp_Sheet.Range("B2"), LookIn:=xlValues)
While Not Rng is Nothing
'do your stuff here
Set rng = ChangeSheet.Range("R" & Rng.Row & ":R" & ColarLastRow).Find _
(What:=Temp_Sheet.Range("B2"), LookIn:=xlValues)
Wend
Related
I have a workbook that copies a range of cells from one worksheet and then pastes them on a another worksheet, beneath row 26, based on the date.
I am trying to check for the existence of a part of text in row 5-25, prior to pasting the selection so i can highlight it a special color.
The below subroutine works fine to plot how I want, but when I try to call the function checkValue2 to FIND if the text exists, it runs once and then stops.
I am not sure if I have too many ranges identified or if the FIND activates the wrong sheet. Any help would be appreciated
Sub buildGantt()
clearGantt
Dim fundingDate As Range
Dim SourceLastRow As Long
Dim sourceBook As Workbook
Dim sourceSheet As Worksheet
Dim copyRange As Range
Dim sched As Worksheet
Dim startWeek As Date
Dim endWeek As Date
Dim Col_letter
Dim Col_letter2
Dim Col_letter3
Dim f As Range
Dim projRange As Range
Dim x As Integer
Dim Modality As String
Dim modColor As Long
On Error Resume Next
With Application
.ScreenUpdating = False
End With
Set sourceBook = ThisWorkbook
Set sourceSheet = sourceBook.Worksheets("Oz")
Set sched = ThisWorkbook.Sheets("Schedule")
'Determine last row of source from Oz which is the source worksheet
With sourceSheet
SourceLastRow = .Cells(.Rows.Count, "O").End(xlUp).Row
End With
'sorts sourcesheet based on Mech Start
sourceSheet.AutoFilterMode = False
For x = 2 To SourceLastRow
If sourceSheet.Range("L" & x).Value > (Now() - 21) Then 'L is install start
Modality = sourceSheet.Range("A" & x).Value
'MsgBox "what is in col A" & Modality
Select Case sourceSheet.Range("A" & x).Value
Case Is = "Holiday"
modColor = RGB(183, 222, 232)
Case Is = "PTO"
modColor = RGB(255, 153, 204)
Case Else
modColor = RGB(146, 208, 80)
End Select
Modality = ""
Set copyRange = sourceSheet.Range("G" & x & ":S" & x) 'the 12 columns to be copied
Set f = sched.Cells.Range("3:3").Find(sourceSheet.Range("L" & x).Value) 'finds install start
If Not f Is Nothing Then
Col_letter = Split(Cells(1, f.Column).Address(True, False), "$")(0)
Col_letter2 = Split(Cells(1, (f.Column + 12)).Address(True, False), "$")(0)
Col_letter3 = Split(Cells(1, (f.Column + 14)).Address(True, False), "$")(0)
'paste in sched
copyRange.Copy Destination:=sched.Range(Col_letter & (x + 40))
Set projRange = sched.Cells.Range(Col_letter & (x + 40) & ":" & Col_letter2 & (x + 40))
sched.Cells.Range(Col_letter3 & (x + 40)).Value = connectCells(projRange)
sched.Range(Col_letter & (x + 40)).Interior.Color = modColor
'this is the part that does not work properly
SOrder = sched.Cells.Range(Col_letter & (x + 40)) 'used to identify what will be searched for
columnL = Col_letter ' identifies what colum to search
MsgBox "returned value=" & checkValue2(SOrder, columnL) ' this works......but only allows it to run once
Else
'
End If
Set copyRange = Nothing
Set f = Nothing
Set Col_letter = Nothing
Set Col_letter2 = Nothing
Set Col_letter3 = Nothing
Else
'
End If
Next x
sched.AutoFilterMode = False
'Cells.AutoFilter
With Application
.ScreenUpdating = True
End With
End Sub
Function checkValue2(str As String, ColumnLetter As String) As String
Dim srchRng As Range
Dim status As String
'we only need to search in row 5 to 25
'we are looking for the SOrder as part of the test contained in the cells above where it will be pasted
With ThisWorkbook.Sheets("Schedule")
Set srchRng = .Range(ColumnLetter & "5:" & ColumnLetter & "25").Find(what:=str, _
LookIn:=xlValues, _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not srchRng Is Nothing Then
'MsgBox "SO found"
status = "green"
Else
'MsgBox "SO Not found"
status = "Red"
End If
End With
checkValue2 = status
End Function
I have been trying to write a piece of vba code, so that I can find all of the duplicates in a column, highlight them in red and bring up a message box listing all those duplicated;
and I want the code to do this for column C across multiple sheets. This is essentially to replace conditional formatting, as it was slowing down the workbook about 8 seconds.
This is what I have so far, but it isn't really working.
Sub FindDuplicates()
Sheetcounter = 0
Set MyData = Worksheets("Sheet1").Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
Do Until Sheetcounter = 3
Set MyUniqueList = CreateObject("Scripting.Dictionary")
MyUniqueList.RemoveAll
Range(Cells(1, 1), Cells(5000, 1)).Interior.Color = xlNone
Application.ScreenUpdating = False
MyDupList = "": MyCounter = 0
For Each Cell In MyData
If Evaluate("COUNTIF(" & MyData.Address & "," & Cell.Address & ")") > 1 Then
If Cell.Value <> "" Then
Cell.Interior.Color = RGB(255, 80, 80)
If MyUniqueList.exists(CStr(Cell)) = False Then
MyCounter = MyCounter + 1
MyUniqueList.Add CStr(Cell), MyCounter
If MyDupList = "" Then
MyDupList = Cell
Else
MyDupList = MyDupList & vbNewLine & Cell
End If
End If
End If
Else
Cell.Interior.ColorIndex = xlNone
End If
Next Cell
Application.ScreenUpdating = True
If MyDupList <> "" Then
MsgBox "The following entries have been used more than once:" & vbNewLine & MyDupList
Else
MsgBox "There were no duplicates found in " & MyData.Address
End If
Sheetcounter = Sheetcounter + 1
If Sheetcounter = 1 Then
Set MyData = Worksheets("Sheet2").Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
End If
If Sheetcounter = 2 Then
Set MyData = Worksheets("Sheet3").Range("C1:C" & Cells(Rows.Count, "C").End(xlUp).Row)
End If
Loop
End Sub
you can simplify your sub like follows:
Option Explicit
Sub FindDuplicates()
Dim sheetCounter As Long
Dim myData As Range, cell As Range
Dim myUniqueList As Scripting.Dictionary
Set myUniqueList = CreateObject("Scripting.Dictionary")
For sheetCounter = 1 To 3
myUniqueList.RemoveAll
With Worksheets("Sheet00" & sheetCounter)
Set myData = .Range("C1", .Cells(.Rows.Count, "C").End(xlUp))
End With
myData.Interior.Color = xlNone
For Each cell In myData.SpecialCells(xlCellTypeConstants)
If WorksheetFunction.CountIf(myData, cell) > 1 Then
cell.Interior.Color = RGB(255, 80, 80)
If Not myUniqueList.Exists(CStr(cell)) Then myUniqueList.Add CStr(cell), myUniqueList.Count + 1
End If
Next cell
If myUniqueList.Count > 0 Then
MsgBox "The following entries have been used more than once:" & vbNewLine & Join(myUniqueList.Keys, vbNewLine)
Else
MsgBox "There were no duplicates found in " & myData.Address
End If
Next sheetCounter
End Sub
This is my desired flow:
On "Sheet2" you can select a macro "Search by first name"
You see a popup to enter a name, you enter a name (X) and select ok
It will search the next sheet, "Master", and look for results where first name = X
and finally return these results back on "Sheet2"
Here's a screenshot of the two sheets:
Sheet 2
and
Master
The following VB code means that it only returns 1 result when there should be multiple sometimes:
Sub Searchbyfirstname()
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim fFirst As String
Dim i As Long
Dim MyVal As String
MyVal = InputBox("Enter the first name of the employees record you need", "Search By First Name", "")
If MyVal = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Cells(5, 1)
.Value = "The below data has been found for " & MyVal & ":"
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
i = 2
For Each wks In ActiveWorkbook.Worksheets
If wks.Name <> "List" Then
With wks.Range("B:B")
Set rCell = .Find(MyVal, , , xlWhole, xlByColumns, xlNext, False)
If Not rCell Is Nothing Then
fFirst = rCell.Address
Do
rCell.Hyperlinks.Add Cells(6, 1), "", "'" & wks.Name & "'!" & rCell.Address
wks.Range("A" & rCell.Row & ":Z" & rCell.Row).Copy Destination:=Cells(6, 1)
Set rCell = .FindNext(rCell)
i = i + 3
Loop While Not rCell Is Nothing And rCell.Address <> fFirst
End If
End With
End If
Next wks
Set rCell = Nothing
If i = 2 Then
MsgBox "No record for " & MyVal & " has been found", 64, "No Matches"
Cells(1, 1).Value = ""
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
Any help would be very much appreciated, thanks!
Ok so I am pretty sure I have the answer now that Maertin and chris neilsen pointed out the errors with hardcoding.
I have posted my code again but the points where I have added or changed are not code (didn't know the best way to format this):
Sub Searchbyfirstname()
Dim wks As Excel.Worksheet
Dim rCell As Excel.Range
Dim fFirst As String
Dim i As Long
Dim MyVal As String
MyVal = InputBox("Enter the first name of the employees record you need", "Search By First Name", "")
If MyVal = "" Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
With Cells(5, 1)
.Value = "The below data has been found for " & MyVal & ":"
.EntireColumn.AutoFit
.HorizontalAlignment = xlCenter
End With
i = 2
For Each wks In ActiveWorkbook.Worksheets
If wks.Name <> "List" Then
With wks.Range("B:B")
Set rCell = .Find(MyVal, , , xlWhole, xlByColumns, xlNext, False)
If Not rCell Is Nothing Then
fFirst = rCell.Address
Dim x As Integer
x = 6
With Sheets("Sheet2")
.Rows(6 & ":" & .Rows.Count).Delete
End With
' for this part I have created the variable x, then I'm assigning this 6 because that's the first row I want to put the data in, then I am saying if there's anything in row 6 or below, delete it
Do
rCell.Hyperlinks.Add Cells(x, 1), "", "'" & wks.Name & "'!" & rCell.Address
'see this and row below, instead of being Cells(6, 1), it is now x and this means it will paste to 6, then if there's another 7 and so on
wks.Range("A" & rCell.Row & ":Z" & rCell.Row).Copy Destination:=Cells(x, 1)
Set rCell = .FindNext(rCell)
i = i + 3
x = x + 1
' Here I am incrementing x by 1 so that if there's another piece of data to paste it will paste in the next row - on first go this would be row 7
Loop While Not rCell Is Nothing And rCell.Address <> fFirst
End If
End With
End If
Next wks
Set rCell = Nothing
If i = 2 Then
MsgBox "No record for " & MyVal & " has been found", 64, "No Matches"
Cells(1, 1).Value = ""
With Sheets("Sheet2")
.Rows(5 & ":" & .Rows.Count).Delete
End With
End If
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub
following my post If cell value matches a UserForm ComboBox column, then copy to sheet.
I have managed to get the code to work to move the check the names and move then to the correct sheets.
The problem i am having is checking if the sheets exists. If it finds a match in the sheet and column 2 in the combobox but there is no sheet for the value then it crashes the code.
Once all the information has been copied to the relevant sheets, i would like it to display a msgbox telling the user how many rows of data have been copied to the respective sheets.
Dim i As Long, j As Long, lastG As Long, strWS As String, rngCPY As Range
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
On Error GoTo bm_Close_Out
' find last row
lastG = sheets("Global").Cells(Rows.Count, "Q").End(xlUp).row
For i = 3 To lastG
lookupVal = sheets("Global").Cells(i, "Q") ' value to find
' loop over values in "details"
For j = 0 To Me.ComboBox2.ListCount - 1
currVal = Me.ComboBox2.List(j, 2) ' value to match
If lookupVal = currVal Then
Set rngCPY = sheets("Global").Cells(i, "Q").EntireRow
strWS = Me.ComboBox2.List(j, 1)
On Error GoTo bm_Need_Worksheet '<~~ if the worksheet in the next line does not exist, go make one
With Worksheets(strWS)
rngCPY.Copy
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
End With
End If
Next j
Next i
GoTo bm_Close_Out
bm_Need_Worksheet:
On Error GoTo 0
With Worksheet
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsTemplate As Worksheet: Set wsTemplate = wb.sheets("Template")
Dim wsPayment As Worksheet: Set wsPayment = wb.sheets("Payment Form")
Dim wsNew As Worksheet
Dim lastRow2 As Long
Dim Contract As String: Contract = sheets("Payment Form").Range("C9").value
Dim SpacePos As Integer: SpacePos = InStr(Contract, "- ")
Dim Name As String: Name = Left(Contract, SpacePos)
Dim Name2 As String: Name2 = Right(Contract, Len(Contract) - Len(Name))
Dim NewName As String: NewName = strWS
Dim CCName As Variant: CCName = Me.ComboBox2.List(j, 0)
Dim lastRow As Long: lastRow = wsPayment.Range("U36:U53").End(xlDown).row
If InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") > 0 Then
lastRow2 = wsPayment.Range("A23:A39").End(xlDown).row
Else
lastRow2 = wsPayment.Range("A18:A34").End(xlDown).row
End If
wsTemplate.Visible = True
wsTemplate.Copy before:=sheets("Details"): Set wsNew = ActiveSheet
wsTemplate.Visible = False
If InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") > 0 Then
With wsPayment
For Each cell In .Range("A23:A39")
If Len(cell) = 0 Then
If sheets("Payment Form").Range("A20").value = "Network" Then
cell.value = NewName & " - " & Name2 & ": " & CCName
Else
cell.value = NewName & " - " & Name2 & ": " & CCName
End If
Exit For
End If
Next cell
End With
Else
With wsPayment
For Each cell In .Range("A18:A34")
If Len(cell) = 0 Then
If sheets("Payment Form").Range("A20").value = "Network" Then
cell.value = NewName & " - " & Name2 & ": " & CCName
Else
cell.value = NewName & " - " & Name2 & ": " & CCName
End If
Exit For
End If
Next cell
End With
End If
If InStr(1, sheets("Payment Form").Range("A20").value, "THE VAT SHOWN IS YOUR OUTPUT TAX DUE TO CUSTOMS AND EXCISE") > 0 Then
With wsNew
.Name = NewName
.Range("D4").value = wsPayment.Range("A23:A39").End(xlDown).value
.Range("D6").value = wsPayment.Range("L11").value
.Range("D8").value = wsPayment.Range("C9").value
.Range("D10").value = wsPayment.Range("C11").value
End With
Else
With wsNew
.Name = NewName
.Range("D4").value = wsPayment.Range("A18:A34").End(xlDown).value
.Range("D6").value = wsPayment.Range("L11").value
.Range("D8").value = wsPayment.Range("C9").value
.Range("D10").value = wsPayment.Range("C11").value
End With
End If
wsPayment.Activate
With wsPayment
.Range("J" & lastRow2 + 1).value = 0
.Range("L" & lastRow2 + 1).Formula = "=N" & lastRow2 + 1 & "-J" & lastRow2 + 1 & ""
.Range("N" & lastRow2 + 1).Formula = "='" & NewName & "'!L20"
.Range("U" & lastRow + 1).value = NewName & ": "
.Range("V" & lastRow + 1).Formula = "='" & NewName & "'!I21"
.Range("W" & lastRow + 1).Formula = "='" & NewName & "'!I23"
.Range("X" & lastRow + 1).Formula = "='" & NewName & "'!K21"
End With
End With
On Error GoTo bm_Close_Out
Resume
bm_Close_Out:
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = True
End With
With help from Jeeped I have manage to get the code for copying the rows to the relevant sheets, and if the sheet doesn't exists then it create it. I just need help with problem two above.
Attempting to use a Worksheet Object that does not exist throws an error. If you catch that error and create a worksheet with the name that you are looking for, you can Resume back to the point where the error was thrown and continue your processing.
Private Sub CommandButton7_Click()
Dim i As Long, j As Long, lastG As Long, strWS As String, strMSG As String
dim rngHDR as range, rngCPY aS range
With Application
.ScreenUpdating = False
.EnableEvents = False
.CutCopyMode = False
End With
On Error GoTo bm_Close_Out
' find last row
lastG = Sheets("Global").Cells(Rows.Count, "Q").End(xlUp).Row
For i = 3 To lastG
lookupVal = Sheets("Global").Cells(i, "Q") ' value to find
' loop over values in "details"
For j = 0 To Me.ComboBox2.ListCount - 1
currVal = Me.ComboBox2.List(j, 2) ' value to match
If lookupVal = currVal Then
set rngHDR = Sheets("Global").Cells(1, "Q").EntireRow
set rngCPY = Sheets("Global").Cells(i, "Q").EntireRow
strWS = Me.ComboBox2.List(j, 1)
On Error GoTo bm_Need_Worksheet '<~~ if the worksheet in the next line does not exist, go make one
With WorkSheets(strWS)
rngCPY .copy
.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Insert shift:=xlDown
End With
exit for
End If
Next j
if j >= Me.ComboBox2.ListCount then _
strMSG = strMSG & "Not found: " & lookupVal & chr(10)
Next i
GoTo bm_Close_Out
bm_Need_Worksheet:
On Error GoTo 0
With Worksheets.Add(after:=Sheets(Sheets.Count))
.Name = strWS
'maybe make a header row here; watch out you do not lose your copy
rngHDR.copy destination:=.cells(1, 1)
End With
On Error GoTo bm_Close_Out
Resume
bm_Close_Out:
With Application
.ScreenUpdating = True
.EnableEvents = True
.CutCopyMode = False
End With
debug.print strMSG
'the next is NOT recommended as strMSG could possibly be VERY long
'if cbool(len(strMSG)) then msgbox strMSG
End Sub
There is a question about whether the new worksheet needs a column header label row but that should be fairly easily rectified.
You could use a function like this :
Sub test_atame()
Dim Ws As Worksheet
Set Ws = Sheet_Exists(ThisWorkbook, "Sheet1")
Set Ws = Sheet_Exists(ActiveWorkbook, "Sheet1")
End Sub
Here is the function :
Public Function Sheet_Exists(aWorkBook As Workbook, Sheet_Name As String) As Worksheet
Dim Ws As Worksheet, _
SExistS As Boolean
SExistS = False
For Each Ws In aWorkBook.Sheets
If Ws.Name <> Sheet_Name Then
Else
SExistS = True
Exit For
End If
Next Ws
If SExistS Then
Set Sheet_Exists = aWorkBook.Sheets(Sheet_Name)
Else
Set Sheet_Exists = Nothing
MsgBox "The sheet " & Sheet_Name & " wasn't found in " & aWorkBook.Name & vbCrLf & _
"Break code to check and correct.", vbCritical + vbOKOnly
End If
End Function
Maybe a check like:
Public Function SheetExists(ByVal Book As Workbook, ByVal SheetName As String) As Boolean
On Error Resume Next
Dim wsTest As Worksheet
Set wsTest = Book.Worksheets(SheetName)
If Not wsTest Is Nothing Then SheetExists = True
End Function
Why does the following VBA script not show any message boxes when row 4, 5 and 6 are all empty...
Sub Test()
LastRow = 40
For i = LastRow To 3 Step -1
Set myRange = Range("B" & i & ":T" & i)
If WorksheetFunction.CountA(myRange) = 0 Then
MsgBox "Empty " & Cells(i, 1).Row
Else
x = x
End If
Next
End Sub
Just test both column ranges:
Sub Test()
LastRow = 40
For i = LastRow To 3 Step -1
count = WorksheetFunction.CountA(Range("B"&i & ":D"&i))
count = count + WorksheetFunction.CountA(Range("F"&i & ":T"&i))
If count = 0 Then
MsgBox "Empty " & i
End If
Next
End Sub
edit: or build a range object which contains the two column ranges, intersect that with the last row, and move this range object in the loop. This way, you don't build the range object anew in each iteration:
Sub Test()
Dim rng As Range, colrng As Range
Dim LastRow As Long
Dim i As Long
LastRow = 40
Set colrng = Application.Union(Range("B:D"), Range("F:T"))
Set rng = Application.Intersect(colrng, Rows(LastRow))
For i = LastRow To 3 Step -1
If WorksheetFunction.CountA(rng) = 0 Then
MsgBox "Empty row: " & i
End If
Set rng = rng.Offset(-1, 0)
Next
End Sub
As good practice, always declare your variables, and use long integers for row or column indices.
Sub Test()
LastRow = 40
For i = LastRow To 3 Step -1
Set myRange = Range("B" & i & ":T" & i)
If WorksheetFunction.CountIf(myRange,"<>") = 0 Then 'count where it's not a null or empty string
MsgBox "Empty " & Cells(i, 1).Row
Else
x = x
End If
Next
End Sub
The only way I can seem to do it is a slow way:
LastRow = Range("B:Z").Find(What:="*", LookIn:=xlValues, SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
LastColumn = Cells.Find(What:="*", LookIn:=xlFormulas, SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
For i = LastRow To 3 Step -1
BlankRow = False
For j = 2 To LastColumn
If Cells(i, j).Value <> "" Then
Blank = False
Exit For
End If
BlankRow = True
Next j
If BlankRow = True Then
x = x
End If
Next i