Simple VBA Program - Create a search report

[tonx]

Hello everyone,

I'm really suck and need some help, please and thank you

The goal is that I want to create a vba script that will essentially scan the entire excel document based on a specific date that im looking for and spit it out based on each column.


Excel table:

Name	Green Network	Blue Network	Yellow Network	White Network	Black Network
Chapter	5/16/13	8/12/13	12/1/13	4/12/13	5/21/13
Chapter 2	5/17/13	8/13/13	12/2/13	4/13/13	5/22/13
Verse	5/18/13	9/13/13	9/14/13	5/21/13	5/23/13
Verse 2	11/13/13	5/21/13	9/15/13	4/15/13	9/12/13
Section	11/14/13	8/16/13	12/5/13	4/16/13	5/21/13
Section 2	11/15/13	8/17/13	5/21/13	4/17/13	5/21/13
Part	5/22/13	8/18/13	12/7/13	4/18/13	9/15/13
Part 2	5/23/13	8/19/13	12/8/13	4/19/13	9/16/13

For example,
I want to find out where 5/21/13 is and I want to show the column and its entry. I want to spit out a record that looks like this


Blue Network
5/21/13
Verse 2


Black Network
5/21/13
Chapter
Section
Section 2


Yellow Network
5/21/13
Section 2


White Network
5/21/13
Verse

Any help would be great

[bgoree09]

Good afternoon,

The attached file uses formulas instead of VBA to create the example report. In this, red fonts are helpers and the report is produced in the blue section with the green cell being the input for the target date. Hope this helps.

Have a good weekend,

[p45cal]

This code assumes the table is at A1:F9 of the active sheet.
The results are added below the last used cell in column A.

Sub blah()
'SearchDate = CDate("21 may 2013")
SearchDate = CDate(Application.InputBox("Enter date like" & vbLf & "21 Aug 2013", "Enter date", , , , , , 2))
For Each colm In Range("A1:F9").Columns 'adjust range.
  For Each cll In colm.Cells
    If cll.Value = SearchDate Then
      If colm.Column <> currentColumn Then
        currentColumn = colm.Column
        Cells(Rows.Count, "A").End(xlUp).Offset(2).Value = colm.Cells(1).Value
        Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = cll.Value
      End If
      Cells(Rows.Count, "A").End(xlUp).Offset(1).Value = Cells(cll.Row, "A").Value
    End If
  Next cll
Next colm
End Sub

[tonx]

Thanks everyone for all your responses.
I was able to gathering the following that works, but im having another issue.

I realized that the data is a bit messy. What would be the easiest way to let it output the information in the following way, while also including any text that may happen to be next to the date in the excel cells:

5/21/13	Blue Network	Verse 2
5/21/13	Black Network	Chapter
Solution for 5/21/2013	Black Network	Section
[Amend] 5/21/2013	Black Network	Section 2
5/21/13	Yellow network	Section 2
5/21/13	White network	Verse

Here is my code that works:

Sub NetworkByDateReport()
  Dim R As Long, C As Long, Rw As Long, RowOffset As Long
  Dim WhatDate As Date, DS As Worksheet, OS As Worksheet
  Set DS = Sheets("Sheet1") 'Data sheet name
  Set OS = Sheets("Sheet2") 'Output sheet name
  WhatDate = Application.InputBox("What date?", Type:=1)
  For C = 2 To DS.Cells(1, Columns.Count).End(xlToLeft).Column
    For R = 2 To DS.Cells(Rows.Count, "A").End(xlUp).Row
      If DS.Cells(R, C).Value = WhatDate Then
        With OS.Cells(Rows.Count, "A").End(xlUp)
          RowOffset = 2 + 2 * (.Row = 1)
          .Offset(RowOffset).Value = DS.Cells(1, C).Value
          .Offset(RowOffset + 1).Value = DS.Cells(R, C).Value
          .Offset(RowOffset + 2).Value = DS.Cells(R, "A").Value
        End With
      End If
    Next
  Next
End Sub

[/QUOTE]

Name	Green Network	Blue Network	Yellow Network	White Network	Black Network
Chapter	5/16/13	8/12/13	12/1/13	4/12/13	5/21/13
Chapter 2	5/17/13	8/13/13	12/2/13	4/13/13	5/22/13
Verse	5/18/13	9/13/13	9/14/13	5/21/13	5/23/13
Verse 2	11/13/13	5/21/13	9/15/13	4/15/13	9/12/13
Section	11/14/13	8/16/13	12/5/13	4/16/13	Soultion for 5/21/13
Section 2	11/15/13	8/17/13	5/21/13	4/17/13	[Amend] 5/21/13
Part	5/22/13	8/18/13	12/7/13	4/18/13	9/15/13
Part 2	5/23/13	8/19/13	12/8/13	4/19/13	9/16/13

Thanks in advance