Re: Caching?
- From: "Dean" <whooshbopbang4@xxxxxxxxxxxx>
- Date: Tue, 7 Nov 2006 08:59:25 -0800
I assume that this was to be added to the macro with nothing taken out,
right? If so, this is what happened.
At the point where it usually halts (the 19th file being imported), instead
it informed me that "outputtemplate.xls" is already open and asked if I
wanted to re-open it. Since "outputtemplate" is the very file that the
macro is inside of, I answered no! I then got a run time error 1004. Ctrl
G didn't do anything, but I assume it is the same as choosing the debug
button, which I did. The yellow highlight was not in the "for" line but in
the line after, "workbooks open..., so there was no way I could move it to
the next uncommented line, except to move it backwards, which, I assume,
makes no sense.
This business of the macro asking for the same file which is already calling
it has also been a fleeting symptom on this one machine. Yes, it is in the
folder that the macro is supposedly polling for its contents, so it's not as
outrageous as when it asks for files that were previously deleted.
Just to be sure, I reran the template twice without your changes and,
neither time, did it produce this dialog box asking if I wanted to re-open
the calling file. I am not the sharpest knife in the drawer but,
considering that everything we added was commented out, that seems pretty
odd, don't you think?
Thanks a lot!
Dean
"Peter T" <peter_t@discussions> wrote in message
news:u%23QR2jlAHHA.1196@xxxxxxxxxxxxxxxxxxxxxxx
Add the following after the For dFileCount = 0 line
For dFileCount = 0 To UBound(arrFiles)
' Application.ScreenUpdating = true
' Debug.Print Err.Number; Err.Description
' Debug.Print "dFileCount ", dFileCount
' Debug.Print "UBound(arrFiles) ", UBound(arrFiles)
' If dFileCount <= (arrFUBoundiles) Then
' Debug.Print (arrFUBoundiles)
' End If
' Exit Sub
When the code breaks:
- press ctrl-g to open the Immediate (debug) Window
- remove the comments
- drag the yellow cursor down to the first newly uncommented line
- press F8 repeatedly to Step through the code
Are the dubg comments consistent with what you expect, any error messages
while stepping through.
Regards,
Peter T
"Dean" <whooshbopbang4@xxxxxxxxxxxx> wrote in message
news:iu-dnQfsm8Zea9LYnZ2dnUVZ_vWdnZ2d@xxxxxxxxxxxxxxx
Well, this is where it gets even messier. The author kept revising themaco
to try to make the problems go away, with no success. What I sent youthen.
was
his latest version. In this last version, there is no error message - it
just stops prematurely at the spot where there used to be a file that was
deleted or renamed. I think this is not materially different from the
original file, as far as the failure modes. It was also just stopping
without finishing, later on, aftre i deleted the renamed file. But, in
terms of the original macro, when it first bombed out, after I renamed
the
file but before I chose to delete the renamed file, it said it could not
find the file I had deleted, and when I hit debug, the yellow backgorund
hihglight was at what is now:
For dFileCount = 0 To UBound(arrFiles)
If you can stomach to read on, here is the exact subroutine, as it was
The actual line hihglighted is the very first line: For d = 0 Totemplate,
UBound(arrFiles).
Public Sub ImportFiles()
For d = 0 To UBound(arrFiles)
Application.ScreenUpdating = False
If arrFiles(d) <> Empty Then
GetTheDate (arrFiles(d))
Workbooks.Open (arrFiles(d))
Application.StatusBar = "Processing file " & d + 1 & ": " &
arrFiles(d)
sDF = ActiveWorkbook.Name
For s = 1 To ActiveWorkbook.Sheets.Count
Sheets(s).Select
s*** = Active***.Name
If s*** = "lcg" Or s*** = "LCG" Or _
s*** = "lcv" Or s*** = "LCV" Or _
s*** = "mcg" Or s*** = "MCG" Or _
s*** = "mcv" Or s*** = "MCV" Or _
s*** = "scg" Or s*** = "SCG" Or _
s*** = "scv" Or s*** = "SCV" Then
Cells.Select
Selection.MergeCells = False
Range("A4").Select
dRowCount = Active***.UsedRange.Rows.Count
Range("A4:A" & dRowCount).Select
Selection.Copy
Workbooks(sOT).Activate
Sheets(sSheet).Select
If Range("E4").Value = Empty Then
Range("E4").Select
End If
dStart = ActiveCell.Row
Selection.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(0, -2).Select
Workbooks(sDF).Activate
Range("A4").Select
Range("C4:C" & dRowCount & ",D4:D" &
dRowCount).Select
Selection.Copy
Workbooks(sOT).Activate
Selection.PasteSpecial Paste:=xlPasteValues
Selection.End(xlDown).Offset(1, 2).Select
Range("A" & dStart & ":A" & ActiveCell.Offset(-1,
0).Row).Value = sDate
Workbooks(sDF).Activate
End If
Next
Application.DisplayAlerts = False
Workbooks(sDF).Close
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End If
Next
Application.StatusBar = False
End Sub
Thnaks!
Dean
"Peter T" <peter_t@discussions> wrote in message
news:%23ioMICgAHHA.1196@xxxxxxxxxxxxxxxxxxxxxxx
At a quick glance of the code there are various scenarios that might
error.
Which line does the code stop on, if necessary press Ctrl-Break when
you
get
the get the error message.
Regards,
Peter T
"Dean" <whooshbopbang4@xxxxxxxxxxxx> wrote in message
news:U5OdnZu4J8d0MNLYnZ2dnUVZ_uidnZ2d@xxxxxxxxxxxxxxx
Peter T has requested the code for the macros in my problematic
fromto
help figure out why one computer has a problem with it. Keep in mindlooks
that
it only doesn't work on one machine. The output file macro bascially
for all the files in the same folder as it, counts the files (Iand
think),
extracts the date from the input filenames (usually somehting like
"all
portfolio data - 05-31-06.xls") and also copies and pastes some data
justthem into the output template from whihc the macro is called.usually
Right now, the macro always stops at file #19, even though there are
21 and 22 input files in my small test sample. No error message, it
thestops prior to processing the last couple of files, plus some final
overhead, and apparently quits. Originally, the 19th file was a file
that
turned out to have a weird filename that the macro could not extract
ofdate from. So I renamed it into a format that was simialr to thecrashed,
other
fiels that were accepted. When I did this and reran the macro, it
saying it couldn't find a file with the old filename, the one it
didn't
like, the one that I renamed. To be safe, I copied in a fresh version
thethe output template file into the same folder and tried again. But
howerror message was the same. So, I chose to simply delete theI
(renamed)
input file that had been giving me the problem. As I said, now, each
time
attempt to run it on my one best computer, it simply stops
prematurely.
Other, lesser, computers don't seem to have this problem. I tried
putting
it all in a new folder - nothing helped.
Since I always run with a fresh copy of the template, I cannot fathom
machines,it
can seemingly remember that some old filename, or old file, is now notyou
included. It's supposed to find what files are in the same folder
when
run the macro. I'ts not supposed to already know what they might be!now
Thanks! Here is all the macro, done by someone skilled, someone who
is
perplexed. It runs fine on his machine, as it does on my other
involved.just not on my main computer. No macro buttons or toolbars are
As
Option Explicit
Public sPath As String, sAppName As String, sFileName As String, sData
sub-folders."String
Public s*** As String, sDate As String
Public sShares As String, sPrice As String, sTicker As String
Public FS
Public arrFiles, arrData
Public dFileCount As Double, dRowCount As Double, dSheets As Double
Public dPF As Double
Public Sub ImportFiles()
GetFileList
ProcessFiles
PopulateTemplate
SortByDate
End Sub
Public Sub GetFileList()
sPath = ActiveWorkbook.Path & "\"
sAppName = ActiveWorkbook.Name
If IsDim(arrFiles) = True Then arrFiles = Empty
If IsDim(arrData) = True Then arrData = Empty
Set FS = Application.FileSearch
With FS
.NewSearch
.LookIn = sPath
.SearchSubFolders = True
.Filename = "*.xls"
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
ReDim arrFiles(0)
For dFileCount = 1 To .FoundFiles.Count
GetFileName (.FoundFiles(dFileCount))
If sFileName <> ActiveWorkbook.Name Then
arrFiles(dFileCount - 1) = .FoundFiles(dFileCount)
ReDim Preserve arrFiles(UBound(arrFiles) + 1)
End If
Next
Else
MsgBox "No files found in " & sPath & " or its
&End
End If
End With
If IsEmpty(arrFiles(UBound(arrFiles))) = True Then
ReDim Preserve arrFiles(UBound(arrFiles) - 1)
End If
End Sub
Public Sub ProcessFiles()
Application.ScreenUpdating = False
For dFileCount = 0 To UBound(arrFiles)
Workbooks.Open (arrFiles(dFileCount))
GetFileName (arrFiles(dFileCount))
GetFileDate
Application.StatusBar = "Processing file " & dFileCount & " :
"
&sFileName
For dSheets = 1 To Workbooks(sFileName).Sheets.Count
Sheets(dSheets).Select
If CheckSheetName = True Then
dRowCount = Active***.UsedRange.Rows.Count
Range("A4").Select
For dPF = 0 To dRowCount - 3
If ActiveCell.Offset(dPF, 0).Value <> Empty And
IsNumeric(ActiveCell.Offset(dPF, 0).Value) = False Then
If dPF = 0 And IsDim(arrData) = False Then
ReDim arrData(0)
Else
ReDim Preserve arrData(UBound(arrData) +
1)
End If
sData = UCase(s***) & ";" & sDate & ";" & _
ActiveCell.Offset(dPF, 0).Value & ";" & _
ActiveCell.Offset(dPF, 2).Value & ";" & _
ActiveCell.Offset(dPF, 3).Value
arrData(UBound(arrData)) = sData
End If
Next
End If
If IsDim(arrData) = True Then
If IsEmpty(arrData(UBound(arrData))) = True Then
ReDim Preserve arrData(UBound(arrData) - 1)
End If
End If
Next
Application.DisplayAlerts = False
Workbooks(sFileName).Close
Application.DisplayAlerts = True
Next
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Public Sub PopulateTemplate()
Application.ScreenUpdating = False
For dPF = 0 To UBound(arrData)
Application.StatusBar = "Populating template. Please wait...
"
alldPF & " of " & UBound(arrData)Mid(sDate,
SplitVariables (arrData(dPF))
Sheets(sSheet).Select
Range("A4").Select
If ActiveCell.Value <> "" Then
If ActiveCell.Offset(1, 0).Value = "" Then
ActiveCell.Offset(1, 0).Select
Else
Selection.End(xlDown).Offset(1, 0).Select
End If
End If
ActiveCell.Value = sDate
ActiveCell.Offset(0, 2).Value = sShares
ActiveCell.Offset(0, 3).Value = sPrice
ActiveCell.Offset(0, 4).Value = sTicker
Next
arrData = Empty
Application.StatusBar = False
Application.ScreenUpdating = True
End Sub
Public Sub GetFileName(TheFile As String)
sFileName = Strings.Replace(TheFile, sPath, "")
Do Until InStr(1, sFileName, "\") = 0
sFileName = Mid(sFileName, InStr(1, sFileName, "\") + 1,
Len(sFileName))
Loop
End Sub
Public Sub GetFileDate()
sDate = Strings.Replace(sFileName, ".xls", "")
sDate = Right(sDate, 10)
Do Until IsNumeric(Mid(sDate, 1, 1)) = True
sDate = Trim(Mid(sDate, 2, Len(sDate)))
Loop
If InStr(1, sDate, "-") = 0 And Len(sDate) = 6 Then
sDate = Mid(sDate, 1, 2) & "-" & Mid(sDate, 3, 2) & "-" &
5, 2)Order1:=xlDescending,
End If
sDate = Format(sDate, "M/d/yyyy")
If IsDate(sDate) = False Then
MsgBox "The following file does not appear to have a valid
date
in
the filename:" & vbNewLine & vbNewLine & _
sFileName & vbNewLine & vbNewLine & "Resetting this
file.",
vbCritical, "Invalid Date"
ResetWorkbook
End
End If
End Sub
Public Sub SortByDate()
Application.ScreenUpdating = False
For dSheets = 1 To ActiveWorkbook.Sheets.Count
Sheets(dSheets).Select
s*** = Active***.Name
If CheckSheetName = True Then
GetRowCount
Range("A4:E" & dRowCount).Select
Selection.Sort Key1:=Range("A4"),
Key2:=Range("E4") _
, Order2:=xlAscending, Header:=xlNo
Range("A4").Select
Range("B4").Formula =
"=vlookup(E4,LOOKUP!C:D,2,FALSE)"
Range("B4").AddComment
Range("B4").Comment.Text Text:="Dean:" & Chr(10) & "At
the
end, Dean will copy this down as far as he needs to."
End If
Next
Sheets(1).Select
Application.ScreenUpdating = True
End Sub
Public Sub ResetWorkbook()
Application.ScreenUpdating = False
Sheets("LCG").Select
Range("A4:A65536").EntireRow.Delete shift:=xlUp
Sheets("MCG").Select
Range("A4:A65536").EntireRow.Delete shift:=xlUp
Sheets("LCV").Select
Range("A4:A65536").EntireRow.Delete shift:=xlUp
Sheets("MCV").Select
Range("A4:A65536").EntireRow.Delete shift:=xlUp
Sheets("SCG").Select
Range("A4:A65536").EntireRow.Delete shift:=xlUp
Sheets("SCV").Select
Range("A4:A65536").EntireRow.Delete shift:=xlUp
Sheets("LCG").Select
Application.ScreenUpdating = True
End Sub
Public Function CheckSheetName() As Boolean
CheckSheetName = False
s*** = Active***.Name
If s*** = "lcg" Or s*** = "LCG" Or _
s*** = "lcv" Or s*** = "LCV" Or _
s*** = "mcg" Or s*** = "MCG" Or _
s*** = "mcv" Or s*** = "MCV" Or _
s*** = "scg" Or s*** = "SCG" Or _
s*** = "scv" Or s*** = "SCV" Then
CheckSheetName = True
End If
End Function
Public Function IsDim(arr As Variant) As Boolean
On Error GoTo errNotDim
Dim d As Double
d = UBound(arr)
IsDim = True
Exit Function
errNotDim:
IsDim = False
End Function
Public Sub SplitVariables(TheString)
Dim arrVars(4), dVar As Double
For dVar = 0 To 3
arrVars(dVar) = Mid(TheString, 1, InStr(1, TheString, ";") -
1)
TheString = Mid(TheString, InStr(1, TheString, ";") + 1,
Len(TheString))
Next
arrVars(4) = TheString
s*** = arrVars(0)
sDate = arrVars(1)
sTicker = arrVars(2)
sShares = arrVars(3)
sPrice = arrVars(4)
End Sub
Public Sub GetRowCount()
Range("A4").Select
If ActiveCell.Value <> "" Then
If ActiveCell.Offset(1, 0).Value = "" Then
dRowCount = ActiveCell.Row
Else
Selection.End(xlDown).Select
dRowCount = ActiveCell.Row
End If
End If
Range("A4").Select
End Sub
"Dean" <whooshbopbang4@xxxxxxxxxxxx> wrote in message
news:mrmdnUqrQu7H79DYnZ2dnUVZ_t6dnZ2d@xxxxxxxxxxxxxxx
I have a template that basically uses a macro to copy and paste from
intoinput files that are placed in its same folder and paste that stuff
advance.filenames.itself. It also extracts the dates from the end of each of the
thatI ran it with a lot of files there and it, basically, worked. I know
it does not know the names of the files that will be there, in
messagemany
Then, I start over with a fresh template and try to run it again
with
of the files removed from the folder, and VB gives me an error
it'stelling me it can't find some of the removed files. Someone says
waysome sort of caching, apparently. I don't understand. Is there
some
somebodyto clear EXCEL caches? How would a fresh copy know of files that
it,
presumably, has never seen?
Let me know if I need to show you the macro, which was created by
else. I hope not because it seems that my question is more basic
Thanks!
Dean
.
- Follow-Ups:
- Re: Caching?
- From: Peter T
- Re: Caching?
- References:
- Caching?
- From: Dean
- Re: Caching?
- From: Dean
- Re: Caching?
- From: Peter T
- Re: Caching?
- From: Dean
- Re: Caching?
- From: Peter T
- Caching?
- Prev by Date: Re: auto copy from one *** to another
- Next by Date: Variable in cell reference
- Previous by thread: Re: Caching?
- Next by thread: Re: Caching?
- Index(es):
Loading