Linking Sheets and Tables

J

jeremyclover

Having an issue with some reports. I'm trying to automate a "cash"
report that uses several different sources. I'd like to be able to
have the data linked from several different tables into one...however,
the reports that we receive from our vendors have different sheet
names. For instance the excel file is "November" and each sheets name
is it's date (ex: Nov 22, Nov 21). However, the information that I
want is off of the most recent sheet, or the one with the most current
date. Is there a way to link the two, with the names of the excel
file, and the sheets themselves changing. The format of each sheet is
always the same, so I'll be looking at the same cells each time.

Thanks
 
D

Dave Peterson

I think I'd open the workbook(s), find the latest date and then adjust the
formula.

or...

Is there anyway you can ask the end user's to copy the most current sheet to
another worksheet--a worksheet that would never change names? Then your
formulas could always use that one.

It would kind of scare me to mechanize it to do this, though. You're gonna run
into a worksheet named: Nvo 21 someday and it won't be picked up by any
mechanized routines.

========
How about another idea....

You build a macro that creates another workbook that opens each of the workbooks
and extracts the data from the current worksheet. But it plops that data into a
worksheet that is named after the vendor.

So the next step would be creating a table:

I'd put the vendor's name in A2:Axx
The workbook's name (include all the path) in B2:Bxx

Headers in row 1 looked like:
Sheet FileLocation Message SheetUsed


Then when the month changes, you just edit|replace to make a new workbook name.
Then run the macro.

After you've combined those worksheets into that new workbook, you open the
other workbook that is linked to it.

Heck, you could just keep the code and the data in the same workbook with the
links...

So that's what I did and it seemed to work ok...

Option Explicit
Sub testme()
Dim IndexWks As Worksheet
Dim IndexRng As Range
Dim myCell As Range
Dim testStr As String
Dim ErrorFound As Boolean
Dim myMsg As String
Dim wks As Worksheet
Dim wksName As String
Dim tempWkbk As Workbook
Dim MaxWksName As String
Dim MaxWks As Long
Dim iCtr As Long

' Application.ScreenUpdating = False

Set IndexWks = ThisWorkbook.Worksheets("index")
With IndexWks
Set IndexRng = .Range("a2", .Cells(.Rows.Count, "A").End(xlUp))
IndexRng.Offset(0, 2).ClearContents

For Each myCell In IndexRng.Cells
If WorksheetExists(myCell.Value, ThisWorkbook) = False Then
Worksheets.Add.Name = myCell.Value
End If
testStr = ""
On Error Resume Next
testStr = Dir(myCell.Offset(0, 1).Value)
On Error GoTo 0
If testStr = "" Then
ErrorFound = True
myCell.Offset(0, 2).Value = "file missing!"
Else
myCell.Offset(0, 2).Value = "Ok"
End If
Next myCell

If ErrorFound Then
MsgBox "Errors!"
Else
For Each myCell In IndexRng.Cells
Set tempWkbk = Nothing
On Error Resume Next
Set tempWkbk _
= Workbooks.Open(Filename:=myCell.Offset(0, 1).Value, _
ReadOnly:=True)
On Error GoTo 0
If tempWkbk Is Nothing Then
myCell.Offset(0, 2).Value = "File couldn't be opened"
Else
MaxWksName = ""
MaxWks = 0
For Each wks In tempWkbk.Worksheets
wksName = Trim(wks.Name)
For iCtr = Len(wksName) To 1 Step -1
If IsNumeric(Mid(wksName, iCtr, 1)) = False Then
wksName = Mid(wksName, iCtr + 1)
If IsNumeric(wksName) Then
If CLng(wksName) > MaxWks Then
MaxWks = CLng(wksName)
MaxWksName = wks.Name
End If
End If
End If
Next iCtr
Next wks

If MaxWksName = "" Then
myCell.Offset(0, 3).Value = "No Sheet Found"
Else
myCell.Offset(0, 3).Value = "'" & MaxWksName
.Parent.Worksheets(myCell.Value).Cells.Clear
tempWkbk.Worksheets(MaxWksName).Cells.Copy
With .Parent.Worksheets(myCell.Value).Range("a1")
.PasteSpecial Paste:=xlPasteValues
.PasteSpecial Paste:=xlPasteFormats
End With
Application.CutCopyMode = False
End If
tempWkbk.Close savechanges:=False
End If
Next myCell
End If
End With

Application.ScreenUpdating = True
End Sub
Function WorksheetExists(SheetName As Variant, _
Optional WhichBook As Workbook) As Boolean
'from Chip Pearson
Dim WB As Workbook
Set WB = IIf(WhichBook Is Nothing, ThisWorkbook, WhichBook)
On Error Resume Next
WorksheetExists = CBool(Len(WB.Worksheets(SheetName).Name) > 0)
End Function

If you're new to macros, you may want to read David McRitchie's intro at:
http://www.mvps.org/dmcritchie/excel/getstarted.htm
 
J

jeremyclover

I am new to macros, but I did one basically that transfers it to a new
table with consistant fields/features, that was the direction I decided
to go. In the mean time I'm going to go through yours line by
line...apparently I have a lot of learning to do.(Hahah)
 
D

Dave Peterson

Lots/most of it is just checking to see if things exist. And a little loop to
get the numbers from the right side of the worksheet name.

But the real guts is just doing a copy|pastespecial (actually 2 of those).

Post back if you can't figure out what the heck I was trying to do!
 
Top