Loop Iteration wont work as expected - vba

Question

For some reason its not going to the next cell in the range to check the value.
Break down of what is meant to happen
Sub calls Modules1.Getdata
This Checks each row for a notification tag ("True/False"). If true it grabs CompanyNumber calls Module3.Check
Moduel3.Check takes the CompanyNumber checks another sheet/range for Samevalue (Go to next Iteration in Module1.Getdata) Next cell if blank, enter company number etc.
Hope that makes sense.
Sub
Sub Workbook_open()
Call Module1.GetData
End Sub
Module1.GetData
Public EmailAddress As String
Public CompanyNumber As String
Public Name As String
Public Comp As String
Public ID As Integer
Function GetData()
Dim LastRow As String
Dim rng As Range
Worksheets("DDregister").Activate
Range("K2").Select
LastRow = Cells(Rows.Count, "K").End(xlUp).Row
For Each rng In Range("K2:K" + LastRow)
If Not rng.Value = vbNullString Then
Worksheets("DDregister").Activate
Range("K2").Select
Select Case rng.Value
Case 1
Case Is = "True"
rng.Select
Let EmailAddress = ActiveCell.Offset(0, -5).Value
Let CompanyNumber = ActiveCell.Offset(0, -9).Value
Let Name = ActiveCell.Offset(0, -8).Value
Let Comp = ActiveCell.Offset(0, -7).Value
ID = ActiveCell.Offset(0, -10).Value
Call Module3.Check(EmailAddress, CompanyNumber, Name, Comp)
Case 2
Case Is = "False"
End Select
ElseIf rng.Value = vbNullString Then
ThisWorkbook.Save
Application.DisplayAlerts = True
'ThisWorkbook.Close
End If
Next
End Function
Module3.Check
Function Check(EmailAddress As String, CompanyNumber As String, Name As String, Comp As String)
Dim rngCheck As Range
Dim LastRowCheck As String
Dim NewRange As Range
Worksheets("Check").Activate
ActiveSheet.Range("B2").Select
LastRowCheck = Cells(Rows.Count, "B").End(xlDown).Row
For Each rngCheck In Range("B2:B" + LastRowCheck)
Select Case rngCheck.Value
Case 1
Case Is = CompanyNumber
'Go to next iteration
Case 2
Case Is = vbNullString
ActiveCell.Value = CompanyNumber
ActiveCell.Offset(0, 1).Value = "True"
ActiveCell.Offset(0, -1).Value = ID
Call Module2.Email(EmailAddress, CompanyNumber, Name, Comp)
Next
End Function
Module2.Email
Function Email(EmailAddress As String, CompanyNumber As String, Name As String, Comp As String)
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "Subject " & (Comp)
objMessage.From = "EmailAddress#Address.com"
objMessage.Cc = "EmailAddress#Address.com"
objMessage.To = (EmailAddress)
'MsgBox (EmailAddress)
objMessage.TextBody = "Stuff"
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "x.x.x.x"
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
End Function

Answer 1

Assuming "True" And "False" Are actually strings and not the boolean values I think GetData should look more like the following:
Sub GetData()
Dim LastRow As String
Dim rng As Range
Dim EmailAddress As String
Dim CompanyNumber As String
Dim Name As String
Dim Comp As String
Dim ID As Integer
Worksheets("DDregister").Activate
Range("K2").Select
Lastrow = Worksheets("DDregister").Cells(Rows.Count, "K").End(xlUp).Row
For Each rng In Range("K2:K" & LastRow)
Select Case rng.value
Case "True"
EmailAddress = Worksheets("DDregister").Cells(rng.Row,"F").Value
CompanyNumber = Worksheets("DDregister").Cells(rng.Row,"B").Value
Name = Worksheets("DDregister").Cells(rng.Row,"C").Value
Comp = Worksheets("DDregister").Cells(rng.Row,"D").Value
ID = Worksheets("DDregister").Cells(rng.Row,"A").Value
Call Module3.Check(EmailAddress, CompanyNumber, Name, Comp)
Case "False"
Case vbNullString
ThisWorkbook.Save
Application.DisplayAlerts = True
'ThisWorkbook.Close
End Select
Next rng
End Sub
Also this is a sub because it does not return anything and why have you put all of these routines in different modules? Since you are passing the values there is no reason to make them global by listing them outside the sub
P.S. I did not fix your other SELECT CASE Statement but it has similar issues. SELECT CASE syntax the way you are using it is as follows
SELECT CASE [expression]
CASE [condition]
CASE [condition]
CASE ELSE
END SELECT

Answer 2

How far is this from what you need? It all goes into a single standard module and is a complete replacement for you code:
Option Explicit
Public Enum DataRef
ID = 1
CompanyNumber = 2
Name = 3
Comp = 4
Email = 6
End Enum
Sub test()
Dim vData, vSubData
Dim lngRow As Long
With Worksheets("DDregister")
vData = .Range("A2:K" & .Cells(.Rows.Count, "K").End(xlUp).Row)
End With
If Len(vData(1, 11)) > 0 Then
For lngRow = LBound(vData) To UBound(vData)
If vData(lngRow, 11) = "True" Then
With Worksheets("Check").Columns(2)
If .Find(vData(lngRow, DataRef.CompanyNumber), , xlValues) Is Nothing Then
vSubData = Array(vData(lngRow, DataRef.ID), vData(lngRow, DataRef.CompanyNumber), "True")
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, -1).Resize(, 3).Value = vSubData
SendEmail vData(lngRow, DataRef.Email), vData(lngRow, DataRef.Comp)
End If
End With
End If
Next lngRow
Else
ThisWorkbook.Save
End If
End Sub
Sub SendEmail(ByVal EmailAddress As String, ByVal Comp As String)
Dim objMessage As Object
Set objMessage = CreateObject("CDO.Message")
With objMessage
.Subject = "Subject " & Comp
.From = "EmailAddress#Address.com"
.Cc = "EmailAddress#Address.com"
.To = EmailAddress
.TextBody = "Stuff"
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "x.x.x.x"
.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
.Configuration.Fields.Update
.Send
End With
End Sub

Answer 3

I have worked out a way to do it myself, I would really appreciate some feedback, as you might have guessed im new to coding lol
Sub GetData()
Dim LastRow As String
Dim rng As Range
Dim EmailAddress As String
Dim CompanyNumber As String
Dim Name As String
Dim Comp As String
Dim ID As Integer
Dim rngCheck As Range
Dim LastRowCheck As String
Dim TodayDate As Date
TodayDate = Date
Worksheets("DDregister").Activate
Range("K2").Select
LastRow = Cells(Rows.Count, "K").End(xlUp).Row
For Each rng In Range("K2:K" + LastRow)
Worksheets("DDregister").Activate
Select Case rng.Value
Case "True"
rng.Select
EmailAddress = ActiveCell.Offset(0, -5).Value
CompanyNumber = ActiveCell.Offset(0, -9).Value
Name = ActiveCell.Offset(0, -8).Value
Comp = ActiveCell.Offset(0, -7).Value
ID = ActiveCell.Offset(0, -10).Value
Worksheets("Check").Activate
Range("B2").Select
LastRowCheck = Cells(Rows.Count, "B").End(xlUp).Row
For Each rngCheck In Range("B2:B" & LastRowCheck)
Select Case True
Case ActiveCell.Value = CompanyNumber
ActiveCell.Offset(1, 0).Select
Exit For
End Select
If Not IsEmpty(ActiveCell.Value) Then
ActiveCell.Offset(1, 0).Select
ActiveCell.Select
End If
If ActiveCell.Value = "" Then
ActiveCell.Value = CompanyNumber
ActiveCell.Offset(0, 1).Value = "True"
ActiveCell.Offset(0, -1).Value = ID
ActiveCell.Offset(0, 2).Value = TodayDate
Call Email(EmailAddress, CompanyNumber, Name, Comp)
End If
Next rngCheck
Case "False"
Case vbNullString
Call Module2.MsgPopup
'CloseBookMsgBox = MsgBox("Do you want to Close the WorkBook", vbYesNo, "WhatsThis")
'
If Module2.MsgPopup = vbYes Then
ThisWorkbook.Save
ThisWorkbook.Close
'
ElseIf Module2.MsgPopup = vbNo Then
Cancel = "True"
MsgBox "Please make sure you save changes manually and close the work book!"
End If
If Cancel = "True" Then Exit Sub
End Select
Next rng
End Sub
Sub Email(EmailAddress As String, CompanyNumber As String, Name As String, Comp As String)
Set objMessage = CreateObject("CDO.Message")
objMessage.Subject = "stuff" & (Comp)
objMessage.From = "emailaddress"
objMessage.Cc = "emailaddress"
objMessage.to = EmailAddress
objMessage.TextBody = "stuff"
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "x.x.x.x"
objMessage.Configuration.Fields.Item _
("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
objMessage.Configuration.Fields.Update
objMessage.Send
End Sub
As i will be runing a Scheduled task to execute this on open, I need to add a delayed msgbox as we will need to manual alter the document as well. so if the timeout period is reached i need to default to "no". Im attempting this in the below function (itsnt working atm)
Set objWshell = CreateObject(“WScript.Shell”)
Any help on this part would be great, currently telling me that "Object Required on this line ^. Even tho it is "set"
Public Function MsgPopup(Optional Prompt As String, Optional Buttons As VbMsgBoxStyle = vbOKOnly, Optional Title As String, Optional SecondsToWait As Long = 0) As VbMsgBoxResult
Dim objWshell As Object
Set objWshell = CreateObject(“WScript.Shell”)
MsgPopup = objWshell.Popup(Prompt, 20, "Do you want to Close the WorkBook", vbYesNo)
Set objWshell = Nothing
End Function