VBA code needed to find cell value in another sheet

[gabrielmza]

Hi Guys

I need the code in VBA for the following :-

I have two sheets in a workbook.

Sheet 1 cell E12 contains the primary value (or number) to work with.
Sheet 2 column A will contain the value of sheet(1) cell E12 somewhere down the column. In the same row where the value is located, I need to find the value of column D.

Hope that makes sense. Can someone please help?


Regards, Gabriel

 

[Gary McMaster]

Hi Gabriel,

Welcome aboard. Try this sample in a standard module:

Public Sub Test()

Dim oSheet1 As Worksheet
Dim oSheet2 As Worksheet

Dim oLookFor As Range
Dim oFound As Range

'Change sheet names in quotes to match your workbook
Set oSheet1 = ThisWorkbook.Worksheets("Sheet1")
Set oSheet2 = ThisWorkbook.Worksheets("Sheet2")

Set oLookFor = oSheet1.Range("E11")

Set oFound = oSheet2.Range("A:A").Find(what:=oLookFor.Value, lookat:=xlWhole, MatchCase:=False)

If Not oFound Is Nothing Then
    MsgBox Chr(34) & oFound.Offset(0, 3).Value & Chr(34) & ", " & oSheet2.Name & " cell D" & oFound.Row
Else
    MsgBox oLookFor.Value & " not found on sheet " & oSheet2.Name
End If

End Sub

 

[Gary McMaster]

The following line:

Set oLookFor = oSheet1.Range("E11")

Should be:

Set oLookFor = oSheet1.Range("E12")

 

[gabrielmza]

Hi Gary

Thanks for the prompt reply. I implemented the code as part of my 'loop through files' code already existing. My code will loop through files in a directory. The idea was to use the code that you provided to find the cell value "D" and use that value to password protect the workbook. The value found in column "D" should be unique in all cases but when I run the code, the MsgBox pops up with the same value in all cases.

My end result should be the value obtained from the column "D" and use that value to protect the workbook.

Here is my current code :-

Sub ProtectDataSheet()


   Dim MyFolder As String


   Dim MyFile As String


   Dim wbk As Workbook


On Error Resume Next


Application.ScreenUpdating = False


With Application.FileDialog(msoFileDialogFolderPicker)


.Title = "Please select a folder"


.Show


.AllowMultiSelect = False


   If .SelectedItems.Count = 0 Then


MsgBox "You did not select a folder"


      Exit Sub


   End If


MyFolder = .SelectedItems(1) & "\"


End With


MyFile = Dir(MyFolder)


Do While MyFile <> “”


   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)


Dim oSheet1 As Worksheet
Dim oSheet2 As Worksheet


Dim oLookFor As Range
Dim oFound As Range


'Change sheet names in quotes to match your workbook
Set oSheet1 = ThisWorkbook.Worksheets("Current Remuneration Statement")
Set oSheet2 = ThisWorkbook.Worksheets("Data")


Set oLookFor = oSheet1.Range("E12")


Set oFound = oSheet2.Range("A:A").Find(what:=oLookFor.Value, lookat:=xlWhole, MatchCase:=False)


If Not oFound Is Nothing Then
    MsgBox Chr(34) & oFound.Offset(0, 3).Value & Chr(34) & ", " & oSheet2.Name & " cell D" & oFound.Row
Else
    MsgBox oLookFor.Value & " not found on sheet " & oSheet2.Name


End If




    
wbk.Close savechanges:=True


MyFile = Dir


Loop


Application.ScreenUpdating = True


End Sub

Hope this makes sense...

Regards, Gabriel

 

[Gary McMaster]

I believe you almost have it. I didn't actually try the sample below but I think you must change 'ThisWorkbook' to your variable 'wbk'. I highlighted the changes (red=old, blue=new).

You should also be careful with 'On Error Resume Next'. That will allow the code to keep running after an error and could give inaccurate results. A division by zero error for example. If you insist on using 'On Error Resume Next', I suggest you turn it off with 'On Error Goto 0' immediately after the line that you expect to raise an error executes. In your example I believe you could check the contents of your variables for illegal values rather than use an error handler.

Gary

Sub ProtectDataSheet()

Dim MyFolder As String
Dim MyFile As String
Dim wbk As Workbook

On Error Resume Next

Application.ScreenUpdating = False

With Application.FileDialog(msoFileDialogFolderPicker)

    .Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False
    
        If .SelectedItems.Count = 0 Then
        
             MsgBox "You did not select a folder"
             Exit Sub
        
        End If
    
    MyFolder = .SelectedItems(1) & "\"

End With

MyFile = Dir(MyFolder)

Do While MyFile <> ""

   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)

    Dim oSheet1 As Worksheet
    Dim oSheet2 As Worksheet
    
    Dim oLookFor As Range
    Dim oFound As Range
    
    'Change sheet names in quotes to match your workbook
    [COLOR=#ff0000]'Set oSheet1 = ThisWorkbook.Worksheets("Current Remuneration Statement")
    'Set oSheet2 = ThisWorkbook.Worksheets("Data")[/COLOR]
    
    [COLOR=#0000ff]Set oSheet1 = wbk.Worksheets("Current Remuneration Statement")
    Set oSheet2 = wbk.Worksheets("Data")[/COLOR]
    
    Set oLookFor = oSheet1.Range("E12")
    
    Set oFound = oSheet2.Range("A:A").Find(what:=oLookFor.Value, lookat:=xlWhole, MatchCase:=False)
    
    If Not oFound Is Nothing Then
        MsgBox Chr(34) & oFound.Offset(0, 3).Value & Chr(34) & ", " & oSheet2.Name & " cell D" & oFound.Row
    Else
        MsgBox oLookFor.Value & " not found on sheet " & oSheet2.Name
    
    End If
    
    wbk.Close savechanges:=True
    
    MyFile = Dir
Loop

Application.ScreenUpdating = True

End Sub

 

[gabrielmza]

Hi Gary

Ok, I made the suggested changes, and added a line to protect the workbook (in red), but it doesn't seem to set the protection on the workbook Here is my code...

Sub ProtectDataSheet()

Dim MyFolder As String
Dim MyFile As String
Dim wbk As Workbook


On Error Resume Next


Application.ScreenUpdating = False


With Application.FileDialog(msoFileDialogFolderPicker)


    .Title = "Please select a folder"
    .Show
    .AllowMultiSelect = False
    
        If .SelectedItems.Count = 0 Then
        
             MsgBox "You did not select a folder"
             Exit Sub
        
        End If
    
    MyFolder = .SelectedItems(1) & "\"


End With


MyFile = Dir(MyFolder)


Do While MyFile <> ""


   Set wbk = Workbooks.Open(Filename:=MyFolder & MyFile)


    Dim oSheet1 As Worksheet
    Dim oSheet2 As Worksheet
    
    Dim oLookFor As Range
    Dim oFound As Range
    
    'Change sheet names in quotes to match your workbook
    'Set oSheet1 = ThisWorkbook.Worksheets("Current Remuneration Statement")
    'Set oSheet2 = ThisWorkbook.Worksheets("Data")
    
    Set oSheet1 = wbk.Worksheets("Current Remuneration Statement")
    Set oSheet2 = wbk.Worksheets("Data")
    
    Set oLookFor = oSheet1.Range("E12")
    
    Set oFound = oSheet2.Range("A:A").Find(what:=oLookFor.Value, lookat:=xlWhole, MatchCase:=False)
    
    If Not oFound Is Nothing Then
        MsgBox Chr(34) & oFound.Offset(0, 3).Value & Chr(34) & ", " & oSheet2.Name & " cell D" & oFound.Row
[COLOR=#ff0000]        wbk.Protect Password:=("oFound"), Structure:=True, Windows:=True[/COLOR]
    Else
        MsgBox oLookFor.Value & " not found on sheet " & oSheet2.Name
    
    End If
    
    wbk.Close savechanges:=True
    
    MyFile = Dir
Loop


Application.ScreenUpdating = True


End Sub

 

[Gary McMaster]

Try changing this:

wbk.Protect Password:=("oFound"), Structure:=True, Windows:=True

To this:

wbk.Protect Password:=(oFound.Value), Structure:=True, Windows:=True

Please notice the lack of quotation marks. Just plain oFound (no quotes) might work but adding the .Value may make your code more understandable to others.

Gary

 

[gabrielmza]

Hi Gary (Again)... Running the amended code doesn't do much for protecting the workbook - not sure why... I do get the popup through with the different cell values...

Any ideas?


Thanks, Gabriel

 

[Gary McMaster]

I don't see anything obviously wrong with your code.

Just a guess, maybe it is working but not allowing the save because you protected it before saving it though that doesn't seem to make a lot of sense.