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

Chuck1960

New Member
Joined
Aug 14, 2020
Messages
15
Office Version
  1. 2016
Platform
  1. Windows
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:
 

Some videos you may like

Excel Facts

Format cells as time
Select range and press Ctrl+Shift+2 to format cells as time. (Shift 2 is the @ sign).

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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
VBA Code:
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

New Member
Joined
Aug 14, 2020
Messages
15
Office Version
  1. 2016
Platform
  1. Windows
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

New Member
Joined
Aug 14, 2020
Messages
15
Office Version
  1. 2016
Platform
  1. Windows
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
VBA Code:
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

New Member
Joined
Aug 14, 2020
Messages
15
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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.

1597535684770.png


1597535796827.png

Thanks
Chuck
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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 '***

VBA Code:
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

New Member
Joined
Aug 14, 2020
Messages
15
Office Version
  1. 2016
Platform
  1. Windows

ADVERTISEMENT

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

VBA Code:
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

New Member
Joined
Aug 14, 2020
Messages
15
Office Version
  1. 2016
Platform
  1. Windows
Peter,

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

Chuck
 

Peter_SSs

MrExcel MVP, Moderator
Joined
May 28, 2005
Messages
47,926
Office Version
  1. 365
Platform
  1. Windows
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! :eek:)
 
  • Like
Reactions: ZVI

Chuck1960

New Member
Joined
Aug 14, 2020
Messages
15
Office Version
  1. 2016
Platform
  1. Windows
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! :eek:)
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
 

Watch MrExcel Video

Forum statistics

Threads
1,122,530
Messages
5,596,699
Members
414,088
Latest member
rodriboraun

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Top