Look for value in column A then check if cell has a value

[ipbr21054]

Hi,
Currently using this working code below.

It works fine BUT it currently checks a specific cell.

My goal is to look on sheet DATABASE in column A for the value that was taken from sheet INV cell G13 and then cell the cell on this row in column P

Example
Sheet INV G13 value is TOM JONES 001
Activate sheet DATABASE
Look in column A for TOM JONES 001
Now on this row check in column P if value is present.
Thanks.

Sub HYPERLINKP5()
Dim answer As Integer
Dim srcWS As Worksheet, destWS As Worksheet
Set srcWS = ActiveWorkbook.Worksheets("INV")
Set destWS = ActiveWorkbook.Worksheets("DATABASE")
If Trim(destWS.Range("P5").Value) <> "" Then
MsgBox "There is something in P5"
Exit Sub
Else
srcWS.Range("L4").Copy destWS.Range("P5")

With destWS
.Range("P5").Font.Size = 14
.Activate
.Range("P5").Select

Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\DR COPY INVOICES TEST\"
If ActiveCell.Column = Columns("P").Column Then
If Dir(FILE_PATH & ActiveCell.Value & ".pdf") <> "" Then
ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=FILE_PATH & ActiveCell.Value & ".pdf"
Else
ActiveCell.Hyperlinks.Delete
MsgBox (FILE_PATH & ActiveCell.Value & ".pdf" & vbNewLine & vbNewLine & "FILE IS NOT IN FOLDER SPECIFIED, PLEASE CHECK PATH IS CORRECT"), vbCritical
End If
Else
MsgBox "PLEASE SELECT AN INVOICE NUMBER.", vbExclamation, "HYPERLINKING THE INVOICE NUMBER"
End If
End With
End If
With Sheets("INV")
Worksheets("INV").Activate
Worksheets("INV").Range("G13").Select

With ActiveSheet
MsgBox "print disabled"

' ActiveWindow.SelectedSheets.PrintOut copies:=1


answer = MsgBox("DID THE INVOICE PRINT OK ?", vbInformation + vbYesNo, "INVOICE PRINT OK MESSAGE")
If answer = vbNo Then
Exit Sub
Else

Range("L4").Value = Range("L4").Value + 1
Range("G27:L36").ClearContents
Range("G46:G50").ClearContents
Range("L18").ClearContents
Range("G13").ClearContents
Range("G13").Select
ActiveWorkbook.Save
End If
End With
End With
End Sub

 

[ipbr21054]

I am trying to get this code working so i can then use in my first post code.

When i run it i see an error message Subscript Out Of Range
When i debug the line in red below is shown as the issue.

It should be the value from Sheets! Range L4 for which its looking for in column A on Sheets1

Private Sub CommandButton1_Click()
Dim srcWS As Worksheet, destWS As Worksheet
Set srcWS = ActiveWorkbook.Worksheets("Sheet3")
Set destWS = ActiveWorkbook.Worksheets("Sheet1")

Dim rng As Range
Dim cell As Range
Dim findString As String

With Sheets("Sheet1")
      Worksheets("Sheet1").Activate
End With

Set rng = ActiveSheet.Columns("A:A")

findString = Worksheets("Sheets3").Range("L4").Value

Set cell = rng.Find(What:=findString, LookIn:=xlFormulas, _
                    LookAt:=xlWhole, MatchCase:=False)

If cell Is Nothing Then
    cell.Font.Color = vbBlack
Else
    cell.Font.Color = vbRed
    cell.Font.Bold = True
End If
End Sub

 

[Peter_SSs]

When i run it i see an error message Subscript Out Of Range
When i debug the line in red below is shown as the issue.

findString = Worksheets("Sheets3").Range("L4").Value

That is almost certainly because you do not have a worksheet called Sheets3 Are you sur that it isn't Sheet3 instead?

 

[ipbr21054]

Many thanks you are correct & i didnt spot that.
Now the code has found on Sheet1 the value taken from Sheet3 range L4 i need to now check if a value is present in column P on this same row.
Can you advise please

So my goal will then be,Look at value in cell L4,open other worksheet & find that value in column A, then go to cell P on that row & then apply code to check it value is present or not using the below

Code from when it just selected cell P5 but now having to use Find value in column A THEN go to that cell in column P & continue as before.

    With Sheets("INV")
      Worksheets("DATABASE").Activate
      Worksheets("DATABASE").Range("P5").Select
    End With
    
    Exit Sub
    Else
      srcWS.Range("L4").Copy destWS.Range("P5")

    With destWS
      .Range("P5").Font.Size = 14
      .Activate
      .Range("P5").Select
 
    Const FILE_PATH As String = "C:\Users\Ian\Desktop\REMOTES ETC\DR\DR COPY INVOICES\"
    If ActiveCell.Column = Columns("P").Column Then
    If Dir(FILE_PATH & ActiveCell.Value & ".pdf") <> "" Then
      ActiveCell.Hyperlinks.Add Anchor:=ActiveCell, Address:=FILE_PATH & ActiveCell.Value & ".pdf"
    Else
      ActiveCell.Hyperlinks.Delete
      MsgBox (FILE_PATH & ActiveCell.Value & ".pdf" & vbNewLine & vbNewLine & "FILE IS NOT IN FOLDER SPECIFIED, PLEASE CHECK PATH IS CORRECT"), vbCritical
    End If
    Else
      MsgBox "PLEASE SELECT AN INVOICE NUMBER.", vbExclamation, "HYPERLINKING THE INVOICE NUMBER"
    End If

 

[ipbr21054]

This works but stuck with selecting the cell at column P

Private Sub CommandButton1_Click()
Dim srcWS As Worksheet, destWS As Worksheet
Set srcWS = ActiveWorkbook.Worksheets("Sheet3")
Set destWS = ActiveWorkbook.Worksheets("Sheet1")

Dim rng As Range
Dim cell As Range
Dim findString As String

With Sheets("Sheet1")
      Worksheets("Sheet1").Activate
End With

Set rng = ActiveSheet.Columns("A:A")

findString = Worksheets("Sheet3").Range("L4").Value

Set cell = rng.Find(What:=findString, LookIn:=xlFormulas, _
                    LookAt:=xlWhole, MatchCase:=False)

If cell Is Nothing Then
    MsgBox "NO MATCH FOUND"
Else
    "I NOW NEED TO SELECT THE CELL AT COLUMN P"
End If
End Sub