VLOOKUP? Not sure If I need VLOOKUP or a Macro..

[Chuck1960]

I am trying to put together a workbook with multiple pages where I can search for a date on my Summary page and return all instances of the date with the corresponding name and other info on the same row. I am using a lookup sheet with the page names but it only seems to return the first page that encounters the date over and over. I thinking I need a macro but I don't know anything about them.

An help would be appreciated

Chuck

Here is the formula Ive tried for the page name. The other cells use just the column number for the info on that row.
{VLOOKUP($B$3,INDIRECT("'"&INDEX(Lookup_Sheets,MATCH(1, --(COUNTIF(INDIRECT("'"&Lookup_Sheets&"'!$I$2:$I$300"),$B$3)>0),0))&"'!$I$2:$M$300"),4,FALSE)}


Here the example file:

Box

app.box.com

 

[Peter_SSs]

Welcome to the MrExcel board!

You could try this Worksheet_Change event code. To implement ..

1. Make a copy of your workbook and in that copy
2. Delete all those INDIRECT formulas below row 4 in 'SUMMARY REPORT'
3. Right click the 'SUMMARY REPORT' sheet name tab and choose "View Code".
4. Copy and Paste the code below into the main right hand pane that opens at step 3.
5. Close the Visual Basic window & test by entering various dates in cell B3 or clearing that cell

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim a As Variant, b As Variant
  Dim SheetList As Range, cell As Range
  Dim i As Long, j As Long, k As Long
  Dim SearchDate As Date

  If Not Intersect(Target, Range("B3")) Is Nothing Then
    Application.EnableEvents = False
    ActiveSheet.UsedRange.Offset(4).ClearContents
    If IsDate(Range("B3").Value) Then
      SearchDate = Range("B3").Value
      With Sheets("Lookup_Sheets")
        Set SheetList = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
      End With
      For Each cell In SheetList
        With Sheets(cell.Value)
          k = 0
          a = .Range("I2", .Range("I" & .Rows.Count).End(xlUp).Offset(1)).Resize(, 5).Value
          ReDim b(1 To UBound(a, 1), 1 To 5)
          For i = 1 To UBound(a)
            If a(i, 1) = SearchDate Then
              k = k + 1
              For j = 1 To 5
                b(k, j) = a(i, (j + 2) Mod 5 + 1)
              Next j
            End If
          Next i
        End With
        If k > 0 Then Me.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5).Value = b
      Next cell
    End If
    Application.EnableEvents = True
  End If
End Sub

 

[Chuck1960]

Peter, Thats awesome. I thank you so much. Ive been working on this for a week trying to figure out how to make it work. Unfortunately I dont know VBA. Thanks again for the help.

 

[Chuck1960]

Welcome to the MrExcel board!

You could try this Worksheet_Change event code. To implement ..

1. Make a copy of your workbook and in that copy
2. Delete all those INDIRECT formulas below row 4 in 'SUMMARY REPORT'
3. Right click the 'SUMMARY REPORT' sheet name tab and choose "View Code".
4. Copy and Paste the code below into the main right hand pane that opens at step 3.
5. Close the Visual Basic window & test by entering various dates in cell B3 or clearing that cell

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim a As Variant, b As Variant
  Dim SheetList As Range, cell As Range
  Dim i As Long, j As Long, k As Long
  Dim SearchDate As Date

  If Not Intersect(Target, Range("B3")) Is Nothing Then
    Application.EnableEvents = False
    ActiveSheet.UsedRange.Offset(4).ClearContents
    If IsDate(Range("B3").Value) Then
      SearchDate = Range("B3").Value
      With Sheets("Lookup_Sheets")
        Set SheetList = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
      End With
      For Each cell In SheetList
        With Sheets(cell.Value)
          k = 0
          a = .Range("I2", .Range("I" & .Rows.Count).End(xlUp).Offset(1)).Resize(, 5).Value
          ReDim b(1 To UBound(a, 1), 1 To 5)
          For i = 1 To UBound(a)
            If a(i, 1) = SearchDate Then
              k = k + 1
              For j = 1 To 5
                b(k, j) = a(i, (j + 2) Mod 5 + 1)
              Next j
            End If
          Next i
        End With
        If k > 0 Then Me.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(k, 5).Value = b
      Next cell
    End If
    Application.EnableEvents = True
  End If
End Sub

 

[Chuck1960]

Peter,

Again, Thanks for your help.
If I wanted to add 3 more columns N,O,P on each sheet and in the Summary, in order to verify the Street, City, and Email, what part of the script would need to be modified?
The Summary tells me the client name and the address that should be used (Member#/A-Z) however I would like to be able to verify the address is correct in the system by seeing the street and city in the Summary. The email is just extra in case I have to ask for more postage.

Thanks
Chuck

 

[Peter_SSs]

If I wanted to add 3 more columns N,O,P on each sheet and in the Summary, in order to verify the Street, City, and Email, what part of the script would need to be modified?

The changed lines or sections are marked with '***

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim a As Variant, b As Variant
  Dim SheetList As Range, cell As Range
  Dim i As Long, j As Long, k As Long, oset As Long
  Dim SearchDate As Date

  If Not Intersect(Target, Range("B3")) Is Nothing Then
    Application.EnableEvents = False
    ActiveSheet.UsedRange.Offset(4).ClearContents
    If IsDate(Range("B3").Value) Then
      SearchDate = Range("B3").Value
      With Sheets("Lookup_Sheets")
        Set SheetList = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
      End With
      For Each cell In SheetList
        With Sheets(cell.Value)
          k = 0
          a = .Range("I2", .Range("I" & .Rows.Count).End(xlUp).Offset(1)).Resize(, 8).Value '***
          ReDim b(1 To UBound(a, 1), 1 To 8)  '***
          For i = 1 To UBound(a)
            If a(i, 1) = SearchDate Then
              k = k + 1
              '***
              For j = 1 To 8
                Select Case j
                  Case Is < 3: oset = 3
                  Case Is < 6: oset = -2
                  Case Else: oset = 0
                End Select
                b(k, j) = a(i, j + oset)
              Next j
              '***
            End If
          Next i
        End With
        If k > 0 Then Me.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(k, 8).Value = b '***
      Next cell
    End If
    Application.EnableEvents = True
  End If
End Sub

 

[Chuck1960]

The changed lines or sections are marked with '***

Private Sub Worksheet_Change(ByVal Target As Range)
  Dim a As Variant, b As Variant
  Dim SheetList As Range, cell As Range
  Dim i As Long, j As Long, k As Long, oset As Long
  Dim SearchDate As Date

  If Not Intersect(Target, Range("B3")) Is Nothing Then
    Application.EnableEvents = False
    ActiveSheet.UsedRange.Offset(4).ClearContents
    If IsDate(Range("B3").Value) Then
      SearchDate = Range("B3").Value
      With Sheets("Lookup_Sheets")
        Set SheetList = .Range("A2", .Range("A" & .Rows.Count).End(xlUp))
      End With
      For Each cell In SheetList
        With Sheets(cell.Value)
          k = 0
          a = .Range("I2", .Range("I" & .Rows.Count).End(xlUp).Offset(1)).Resize(, 8).Value '***
          ReDim b(1 To UBound(a, 1), 1 To 8)  '***
          For i = 1 To UBound(a)
            If a(i, 1) = SearchDate Then
              k = k + 1
              '***
              For j = 1 To 8
                Select Case j
                  Case Is < 3: oset = 3
                  Case Is < 6: oset = -2
                  Case Else: oset = 0
                End Select
                b(k, j) = a(i, j + oset)
              Next j
              '***
            End If
          Next i
        End With
        If k > 0 Then Me.Range("B" & Rows.Count).End(xlUp).Offset(1).Resize(k, 8).Value = b '***
      Next cell
    End If
    Application.EnableEvents = True
  End If
End Sub

 

[Chuck1960]

Peter,

Thanks for the help. I think I taking a course would be something I would enjoy.

Chuck

 

[Peter_SSs]

You're welcome.

I have to admit that I have not taken a course but learned almost all I know here in the forum. No doubt the purists who have had formal training can see that in my coding and gasp at some of it! )

 

[Chuck1960]

You're welcome.

I have to admit that I have not taken a course but learned almost all I know here in the forum. No doubt the purists who have had formal training can see that in my coding and gasp at some of it! )

My experience is that it does'nt have to be pretty to work. LOL I Knew this was probably pretty simple for someone with the knowledge but, I am an intermediate Excel user and have no knowledge of VBA.
Chuck