PDA

View Full Version : Looking for a solution.



mwarner
06-13-2011, 08:10 AM
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.

Chabu
06-13-2011, 11:06 AM
It would be easier if you provided the workbooks (or a simplified version)

mwarner
06-13-2011, 01:04 PM
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.

Chabu
06-14-2011, 01:44 PM
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

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

mwarner
06-14-2011, 02:02 PM
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!