Results 1 to 4 of 4

Thread: Simple VBA Program - Create a search report

  1. #1

    Question Simple VBA Program - Create a search report



    Register for a FREE account, and/
    or Log in to avoid these ads!

    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

  2. #2
    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,
    Attached Files Attached Files

  3. #3
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,479
    Articles
    0
    Excel Version
    365
    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

  4. #4
    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:

    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("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

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •