Consulting

Results 1 to 5 of 5

Thread: Looking for a solution.

  1. #1
    VBAX Regular
    Joined
    Jun 2011
    Posts
    7
    Location

    Question Looking for a solution.

    Hello,

    This is my first time trying trying to solve a problem with VBA, and using these forums. Thank you to anyone willing to read/reply.

    I have a database that dumps information into excel, and everyday it is updated with todays information.

    If Book 1 is the spreadsheet from the database, which contains a location and measured values at that location, for every day.
    Book 2 is a summary of the measured values with each sheet being a different location, listing these values chronologically.

    I am trying to create a function or macro to automate the process of updating Book 2 using the new values each day from Book 1.
    A VLOOKUP works if I grab only one days worth of data, otherwise i havent figured out an advanced function that will sift through, grab the right location on the right day, and return a value. So i thought a macro might work well here.

    Any help or ideas here is much appreciated. I will do my best to clear up anything I left out, if required.

  2. #2
    VBAX Regular Chabu's Avatar
    Joined
    Dec 2010
    Location
    Brussels
    Posts
    85
    Location
    It would be easier if you provided the workbooks (or a simplified version)

  3. #3
    VBAX Regular
    Joined
    Jun 2011
    Posts
    7
    Location
    The file I attached is a good representation of what I am talking about.
    Book 1 is the data dump from my database, it has dates, locations, and corresponding information.

    Book 2 is the data i want to automatically update with Book 1 information. The cells shaded blue (MM 1-5) are required inputs from Book 1, the others are calculations based off MM 1-5.

    Book 2 is an example of one sheet for one location, there are dozens of similar sheets. This example i provided H 1, but H 2, P 1 and the others would each have a sheet that needs to be updated like book 2.

    Once again, my goal is to have all of my Book 2 spreadsheets updated whenever new information is added to Book 1.
    Attached Files Attached Files

  4. #4
    VBAX Regular Chabu's Avatar
    Joined
    Dec 2010
    Location
    Brussels
    Posts
    85
    Location
    Here it is.
    (the code is already in your workbook attached also)
    You will need to add some formatting code but the basis is there.

    To try it out run the ventilateInput sub while your "Book 1" sheet is active.

    Good luck

    [vba]Option Explicit

    Public Const sDateCol As Long = 1
    Public Const sLocationCol As Long = 2
    Public Const sMM1Col As Long = 3
    Public Const sMM2Col As Long = 4
    Public Const sMM3Col As Long = 5
    Public Const sMM4Col As Long = 6
    Public Const sMM5Col As Long = 7
    Public Const sHeaderRow As Long = 1
    Public Const sDataStartRow As Long = 2

    Public Const tDateCol As Long = 2
    Public Const tMM1Col As Long = 3
    Public Const tMM2Col As Long = 5
    Public Const tMM3Col As Long = 9
    Public Const tMM4Col As Long = 10
    Public Const tMM5Col As Long = 11
    Public Const tNameRow As Long = 3
    Public Const tNameCol As Long = 2
    Public Const tHeaderRow As Long = 4
    Public Const tDataStartRow As Long = 6

    Public Sub ventilateInput()
    Dim aBook As Workbook
    Dim sSheet As Worksheet
    Dim aSheet As Worksheet

    Set aBook = ActiveWorkbook
    Set sSheet = aBook.Worksheets("Book 1")

    Dim sDataRow As Long
    sDataRow = 2
    Dim tEmptyRow As Long

    While sSheet.Cells(sDataRow, sDateCol).Value <> ""
    Set aSheet = getSheet(aBook, sSheet.Cells(sDataRow, sLocationCol).Value)
    tEmptyRow = getFirstEmptyRow(aBook, aSheet)
    aSheet.Cells(tEmptyRow, tDateCol).Value = sSheet.Cells(sDataRow, sDateCol).Value
    aSheet.Cells(tEmptyRow, tMM1Col).Value = sSheet.Cells(sDataRow, sMM1Col).Value
    aSheet.Cells(tEmptyRow, tMM2Col).Value = sSheet.Cells(sDataRow, sMM2Col).Value
    aSheet.Cells(tEmptyRow, tMM3Col).Value = sSheet.Cells(sDataRow, sMM3Col).Value
    aSheet.Cells(tEmptyRow, tMM4Col).Value = sSheet.Cells(sDataRow, sMM4Col).Value
    aSheet.Cells(tEmptyRow, tMM5Col).Value = sSheet.Cells(sDataRow, sMM5Col).Value
    sDataRow = sDataRow + 1
    Wend

    End Sub

    Private Function getSheet(book As Workbook, location As String) As Worksheet
    If isInCollection(book.Worksheets, location) Then
    Set getSheet = book.Worksheets(location)
    Else
    Set getSheet = book.Worksheets.Add
    getSheet.Name = location
    getSheet.Cells(tNameRow, tNameCol).Value = location
    getSheet.Cells(tHeaderRow, tDateCol).Value = "Date"
    getSheet.Cells(tHeaderRow, tMM1Col).Value = "MM1"
    getSheet.Cells(tHeaderRow, tMM2Col).Value = "MM2"
    getSheet.Cells(tHeaderRow, tMM3Col).Value = "MM3"
    getSheet.Cells(tHeaderRow, tMM4Col).Value = "MM4"
    getSheet.Cells(tHeaderRow, tMM5Col).Value = "MM5"

    End If
    End Function

    Private Function isInCollection(Coln As Object, item As String) As Boolean
    Dim obj As Object
    On Error Resume Next
    Set obj = Coln(item)
    isInCollection = Not obj Is Nothing
    End Function

    Private Function getFirstEmptyRow(aBook As Workbook, aSheet As Worksheet) As Long
    If aSheet.Cells(tDataStartRow, tDateCol).Value = "" Then
    getFirstEmptyRow = tDataStartRow
    Else
    getFirstEmptyRow = aSheet.Cells(aSheet.Rows.Count, tDateCol).End(xlUp).Row + 1
    End If
    End Function[/vba]
    Attached Files Attached Files

  5. #5
    VBAX Regular
    Joined
    Jun 2011
    Posts
    7
    Location
    Thank you so much for your help here.
    I will try to modify this as soon as i get a chance.
    I'll let you know how it turns out!

Posting Permissions

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