For Each seems stuck on spot

I'm trying to modify a bit of code I have to cycle through a column and if the cell is empty, pick a value along the row. - The modification is to allow for the fact that in this case it's not a fixed column but driven by the ActiveCell.

I have two issues. I have been playing around with defining the range. What I have now doesn't throw up an error but it doesn't seem to work either because the result is the same many times over.

• Issue 1 seems to be that the For Each function doesn't cycle through the range.
• Issue 2 is that the value it gives me is one it shouldn't, i.e. the cell isn't empty.

It's a very short bit of code and I would have thought fairly simply - so two issues is quite impressive!

Thanks!

Dim myRange As Range
Dim myEmail As String
For Each myRange In sh2.Range(ActiveCell, Cells(ActiveCell.Row + 20, ActiveCell.Column)) 'sh2.Range(ActiveCell, ActiveCell.Offset(20, 0))
        If IsEmpty(myRange) = True Then
           myEmail = myEmail & sh2.Cells(r, 2).Value & ", " & sh2.Cells(r, 1).Value & ";"
        End If
Next myRange

This is my original code. The columns are fixed so I work with offset to find the email address.

Dim myRange As Range
Dim myEmail As String
lastrow = sh3.Cells(Rows.Count, 1).End(xlUp).Row 'counts the number of rows in use
For Each myRange In sh3.Range("A1:A" & lastrow)
If myRange = "x" Then
myEmail = myEmail & myRange.Offset(0, 3).Value & ";"
End If
Next myRange

Hi jolivanes

I'm including the entire code but I just figured out the problem but not sure what to do about it. - The spreadsheets returns that come in and I have to send a reminder to everyone who hasn't sent their badge back by a certain date. So for each month, I move to a different column which is why I need to keep myRange variable. - MyEmail is a container that collects who to send the reminder to.

r is the row of the ActiveCell but the ActiveCell of course won't move which is why I get the same result over. - So I need to activate the row the For Each statement is looking at but I'm not quite sure how that is done.

Public Sub BadgeReminder()
Dim OutApp As Object
Dim OutMail As Object


'Your Sheet names need to be correct in here
    Set sh2 = Sheets("Returns")
    r = ActiveCell.Row
    c = ActiveCell.Column


    With Application
        .EnableEvents = False
        .ScreenUpdating = False
    End With
    
Set OutApp = CreateObject("Outlook.Application")
'Path for Outlook Template
Set OutMail = OutApp.CreateItemFromTemplate("\\nzaklpe021a\SMS\Groups\Administration\Commercial Folder\AdminNZ_Handbook\RadiationDoseMgmt\RadiationBadgeReminder.oft")




Dim myRange As Range
Dim myEmail As String
Dim TopCell As Range
Set TopCell = ActiveCell.End(xlUp)
ActiveCell.Offset(21, 0).Select
For Each myRange In sh2.Range(ActiveCell, Cells(ActiveCell.Row + 20, ActiveCell.Column)) 'sh2.Range(ActiveCell, ActiveCell.Offset(20, 0))
        If IsEmpty(myRange) = True Then
           myEmail = myEmail & sh2.Cells(r, 2).Value & ", " & sh2.Cells(r, 1).Value & ";"
        End If
Next myRange




Dim dtToday As Date
dtToday = Format(Now, "d mmmm YYYY")


Dim strFirstName As String
strFirstName = sh2.Cells(r, 1)




Dim strYear As String
strYear = "2018" 'Right(sh1.Name, 4) doesn't work


'Send Email
    On Error GoTo cleanup
    With OutMail
          
            
        .To = myEmail
        .cc = ""
        .Subject = "Overdue Radiation Badges"
        .Display   'or use .Send
        
        On Error GoTo 0
        Set OutMail = Nothing
    End With


    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
       
    Set OutApp = Nothing
    
    Exit Sub


cleanup:
    Set OutApp = Nothing
    MsgBox Err.Description




Errorcatch:
MsgBox Err.Description


End Sub

Hi Jolivanes

I have attached the sheet with names replaced.

I can't find how to reference column A in the row the (r, 1) thing. One can find the top or bottom of a column but obviously not the first column in a table.

Thanks, Christine

Hi Jolivanes

It works. It was still playing up depending on where my cursor (ActiveCell) was but I've included a line to send it to the top so it's working perfectly now.

So the portion of the code now looks like this:

Dim myRange As Range
Dim myEmail As String
sh2.Cells(1, c).Select
For Each myRange In sh2.Range(ActiveCell, ActiveCell.Offset(20, 0))
        If IsEmpty(myRange) = True Then
          myEmail = myEmail & sh2.Cells(myRange.Row, 2).Value & ", " & sh2.Cells(myRange.Row, 1).Value & ";"
        End If
Next myRange

I had tried

ActiveCell.End(xlUp).Select

to send it to the top but for some reason that wouldn't work.

Thanks for your help, as usual! I am learning. (I'm also having fun.)

Christine