Simple VBA Program - Create a search report

tonx

New member
Joined
Aug 21, 2013
Messages
11
Reaction score
0
Points
0
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:
NameGreen NetworkBlue NetworkYellow NetworkWhite NetworkBlack Network
Chapter5/16/138/12/1312/1/134/12/135/21/13
Chapter 25/17/138/13/1312/2/134/13/135/22/13
Verse5/18/139/13/139/14/135/21/135/23/13
Verse 211/13/135/21/139/15/134/15/139/12/13
Section11/14/138/16/1312/5/134/16/135/21/13
Section 211/15/138/17/135/21/134/17/135/21/13
Part5/22/138/18/1312/7/134/18/139/15/13
Part 25/23/138/19/1312/8/134/19/139/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
confused.png
 
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,
 

Attachments

  • Search_Report_sample.xlsx
    10.6 KB · Views: 24
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.
Code:
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
 
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/13Blue NetworkVerse 2
5/21/13Black NetworkChapter
Solution for 5/21/2013Black NetworkSection
[Amend] 5/21/2013Black NetworkSection 2
5/21/13Yellow networkSection 2
5/21/13White networkVerse



Here is my code that works:

Code:
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("[B][COLOR=#b22222]Sheet1[/COLOR][/B]") [B][COLOR=#008000]'[/COLOR][COLOR=#008000]Data[/COLOR][COLOR=#008000] sheet name[/COLOR][/B]
  Set OS = Sheets("[COLOR=#b22222][B]Sheet2[/B][/COLOR]") [B][COLOR=#008000]'Output sheet name[/COLOR][/B]
  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]


NameGreen NetworkBlue NetworkYellow NetworkWhite NetworkBlack Network
Chapter5/16/138/12/1312/1/134/12/135/21/13
Chapter 25/17/138/13/1312/2/134/13/135/22/13
Verse5/18/139/13/139/14/135/21/135/23/13
Verse 211/13/135/21/139/15/134/15/139/12/13
Section11/14/138/16/1312/5/134/16/13Soultion for 5/21/13
Section 211/15/138/17/135/21/134/17/13[Amend] 5/21/13
Part5/22/138/18/1312/7/134/18/139/15/13
Part 25/23/138/19/1312/8/134/19/139/16/13


Thanks in advance
 
Back
Top