PDA

View Full Version : Return specific cell in that row using row number



SandManTFC
05-14-2020, 09:19 AM
Hi all,

I'm struggling to return what i need from VBA, I'm trying to return the name of the person in column A with the expired date being in column C. I have managed to retrun the row number and the expired date, but no other cell values in that row, screenshot attached.


Private Sub Workbook_Open()


Dim cl As Range
Dim rng As Range
Dim str As String
Dim sht_str As String

Dim sht As Worksheet



sht_str = "Attention! The following training expires within 7 days, or have already expired: " & Chr(10) & Chr(10)

sht_strs = "Test"

For Each sht In Me.Worksheets
sht_str = sht_str & sht.Name & ":"
str = ""
Set rng = sht.Range("A6:D313")




On Error GoTo exit_sub
For Each rw In rng

If rw.Value = "" Then GoTo Next_rw
If rw.Value < Date + 8 Then str = str & Chr(10) & "Row - " & rw.Row & " - " & rw.Value


Next_rw:
Next rw
If str = "" Then str = Chr(10) & "All training is up to date"
sht_str = sht_str & str & Chr(10) & Chr(10)
Next sht
MsgBox sht_str, 48, "Expiring Training Dates!"
exit_sub:


End Sub

SamT
05-14-2020, 11:41 AM
Option Explicit

Private Sub Workbook_Open()
GetExpires 'Don't overload an Event Sub
End Sub


Private Sub GetExpires()
'Your code should all be in this Sub
End Sub

I don't know why you are checking very cell in A6 to D313, when all you need is column C

SandManTFC
05-14-2020, 12:12 PM
OK thanks Sam, I'll clean up the code and use the range as Column C only, still not sure how access Coloumn A for the name.

Paul_Hossler
05-14-2020, 05:52 PM
Some cleanup and variable renaming

I just used plug numbers since I didn't want to type ALL that data in from a picture. You can attach a small sample workbook to make it easier




Option Explicit


Sub TrainingStatus()
Dim dataRange As Range, dataRow As Range
Dim sMsg As String, rowName As String
Dim rowDate As Date
Dim ws As Worksheet
Dim bSomeOutOfDate As Boolean

bSomeOutOfDate = False


sMsg = "Attention! The following training expires within 7 days, or have already expired: " & Chr(10) & Chr(10)

On Error GoTo exit_sub


For Each ws In ThisWorkbook.Worksheets
sMsg = sMsg & ws.Name & ":"

Set dataRange = ws.Range("A6:D313")


For Each dataRow In dataRange.Rows
rowDate = dataRow.Cells(1, 3).Value

If CLng(rowDate) = 0 Then GoTo Next_dataRow

If rowDate < Date + 8 Then
bSomeOutOfDate = True
rowName = dataRow.Cells(1, 1).Value
If Len(rowName) = 0 Then rowName = dataRow.Cells(1, 1).End(xlUp).Value

sMsg = sMsg & Chr(10) & "Row - " & dataRow.Row & " - " & rowName & " -- " & rowDate
End If
Next_dataRow:
Next dataRow
Next ws


If Not bSomeOutOfDate Then sMsg = Chr(10) & "All training is up to date"

MsgBox sMsg & Chr(10) & Chr(10), 48, "Expiring Training Dates!"


exit_sub:


End Sub