VBA beats relative content validation and action
Can anyone point me in the right direction to achieve the following,
I have two columns of content, if there is content in one, there should be content in its adjacent cell.
A B
1 | Content1 | Content2
2 | Content1 | Content2
3 | Content1 | Content2
I have a working macro at the moment
Dim ws As Worksheet
Dim currentCell As Range
Set ws = ThisWorkbook.Sheets(stMember)
Set currentCell = ws.Range("A1")
Do While Not IsEmpty(currentCell)
Set nextCell = currentCell.Offset(0, 1)
If IsEmpty(nextCell) Then
Application.Goto currentCell
MsgBox "Cell " + currentCell + " is empty"
Exit Sub
End If
Set currentCell = currentCell.Offset(1, 0)
Loop
However, both columns A and B can have blank values on the same row, which is fine, so I need to modify my script to be something like (this description is not a macro)
If Col A has content and Col B is OK,
If Col A is empty and Col B, OK
If Col A has content and Col B does not, NOT OK
A B
1 | Content1 | Content2 OK
2 | Content1 | Content2 OK
3 | Content1 | Content2 OK
4 | Content1 | Content2 OK
5 | Content1 | Content2 OK
6 | | OK
7 | Content1 | Content2 OK
8 | Content1 | Content2 OK
9 | Content1 | NOT OK
10| Content1 | Content2 OK
I'm not asking for the actual script, just an outline, perhaps the best way to do this.
Many thanks.
source to share
As I mentioned in the comments, there is no need for VBA CODE. you can use
=IF(AND(B1="",A1<>""),"Not Ok","Ok")
If you really want to use VBA, you don't need to loop :) We will combine the above formula and vba code so that we don't have to loop.
Sub Sample()
Dim lastrow As Long
'~~> Change this to the relevant sheet name
With Sheets("Sheet1")
'~~> Find the last row in Col A/B
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastrow = .Columns("A:B").Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lastrow = 1
End If
'~~> Enter the formula in Col C
.Range("C1:C" & lastrow).Formula = "=IF(AND(B1="""",A1<>""""),""Not Ok"",""Ok"")"
'~~> Convert the formula to values
.Range("C1:C" & lastrow).Value = .Range("C1:C" & lastrow).Value
End With
End Sub
EDIT
Follow-up comments. Is this what you are trying?
Sub Sample()
Dim lastrow As Long
'~~> Change this to the relevant sheet name
With Sheets("Sheet1")
'~~> Find the last row in Col A/B
If Application.WorksheetFunction.CountA(.Cells) <> 0 Then
lastrow = .Columns("A:B").Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
Else
lastrow = 1
End If
For i = 1 To lastrow
If Len(Trim(.Range("A" & i).Value)) <> 0 And _
Len(Trim(.Range("B" & i).Value)) = 0 Then
'~~> Display the message and exit
MsgBox "Cell " & .Range("B" & i).Address & " is empty"
Exit For
End If
Next i
End With
End Sub
source to share