Macro To Lookup Value In Array And Return Value From Second Row

[rameezl17]

Hi Everyone,

I currently have this macro

Sub Find_Phase()
Dim found As Range
Set found = Sheets("1").Rows("17:18").Find(what:=Sheets("Report").Cells(2, 2).Value, LookIn:=xlValues, lookat:=xlWhole)
If found Is Nothing Then
Else
Sheets("Report").Cells(5, 3) = found.Row
End If
End Sub

So far it returns the row number to my "Report" Sheet, however I need the macro to return the value in row 18 that is underneath the row 17 value...

for an example, if the value is found in sheets("1") row 17 column G i need the value in my "Report" sheet to be from sheets("1") row 18 column G.

Im not sure if this macro is the right direction but i am stuck

 

[Fluff]

Any chance you could answer my question?

Also when posting code please use code tags, the # icon in the reply window.

 

[rameezl17]

Question - If the sheet name & project name have no bearing to each other, how do you now which is which?

Im not sure what your asking, in terms of vba or in general?

 

[Fluff]

How do you determine which sheet is for which project?

 

[rameezl17]

How do you determine which sheet is for which project?

As soon as a new project is created then a new sheet is created. It just depends on the user who creates the project to name the project whateveer they want. The sheet name is automatically generated to be the next number in sequential order. Does this answer your question?

 

[Fluff]

No, how would the code "know" that sheet name "6" is project name "WangDangDoogle"

 

[rameezl17]

Can the macro create each sheet as an array and then look and match the project name to Cell A2( the project name that is inputted from the user will always go there), then if it doesn’t match to keep looping around the sheets and if nothing then it doesn’t return anythingrg

 

[rameezl17]

The macro below below does something similar but I need to be able to match the date to a specific row and then the project hours based on name of person, name of project, and date

Sub Generate_Report()


Dim x As Long, i As Long, j As Long, k As Long, p As Long
Dim ary1 As Variant
Dim wsCOUNT As Long
Dim Ws As Worksheet
Dim lastROW As Long, lastCol As Long




wsCOUNT = Application.Sheets.Count


'loops through the sheets
For i = 7 To wsCOUNT
    k = 0


'gets the sheets last row and last column
lastROW = Sheets(i).Range("A" & Rows.Count).End(xlUp).Row
lastCol = Sheets(i).Range("A1").SpecialCells(xlCellTypeLastCell).Column


'sets the current sheet as the array given there are no blank rows/columns
ReDim ary1(1 To lastROW, 1 To lastCol)
ary1 = Sheets(i).Range("A1").CurrentRegion.Value2


'loop through the rows of the array
For j = LBound(ary1) To UBound(ary1)
    
'find  matches between A2 and array
If Sheets("Report").Range("A2").Value = ary1(j, 6) Then




'loop to find project supports
    For k = 1 To 4
        If ary1(j, 6) = ary1(20 + k, 6) Then
            Sheets("Report").Cells(5 + x, 1).Value = ary1(2, 1)
            If k <> 1 Then
            Sheets("Report").Cells(5 + x, 2).Value = "PE Support" & k
            x = x + 1
            Else
            Sheets("Report").Cells(5 + x, 2).Value = "PE Support1"
            x = x + 1
            End If
        
        End If
    Next k
          
'if to find project leads
If ary1(j, 6) = ary1(20, 6) Then
    Sheets("Report").Cells(5 + x, 1).Value = ary1(2, 1)
    Sheets("Report").Cells(5 + x, 2).Value = "PE Lead"
    x = x + 1
    




Else
End If
End If




Next j
Next i

 End Sub

 

[Fluff]

As I said before, when posting code use CODE tags, not quotes.

Try

Sub Find_Phase()
   Dim Cl As Range, Fnd As Range, Fnd2 As Range
   Dim Ws As Worksheet, Sht As Worksheet
   
   Set Ws = Sheets("Report")
   For Each Cl In Ws.Range("A5", Ws.Range("A" & Rows.Count).End(xlUp))
      For Each Sht In Worksheets
         If Sht.Range("A2") = Cl.Value Then
            With Sht
               Set Fnd = .Rows(17).Find(Ws.Range("B2").Value, , xlValues, xlWhole, , , , , False)
               If Fnd Is Nothing Then Exit For
               Cl.Offset(, 2).Value = Fnd.Offset(1)
               Set Fnd2 = .Range("F20:F24").Find(Ws.Range("A2").Value, , , xlWhole, , , False, , False)
               If Not Fnd2 Is Nothing Then Cl.Offset(, 3).Value = Intersect(Fnd2.EntireRow, Fnd.EntireColumn).Value
            End With
            Exit For
         End If
      Next Sht
   Next Cl
End Sub

 

[rameezl17]

I apologize I thought I used quote tags...

This is brilliant! Exactly what I need!!! Now im going to spend time studying to understand the code in further detail!

Thank you very much Fluff!

 

[Fluff]

You're welcome & thanks for the feedback.

I apologize I thought I used quote tags...

You did & that's the problem, I changed them to code tags. In future use code tags.