Page 1 of 2 12 LastLast
Results 1 to 15 of 26
  1. #1
    Silver Lounger
    Join Date
    Jan 2001
    Location
    Northern, California, USA
    Posts
    1,886
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Multiple Spreadsheets II

    Sorry Mum, needed a new thread, <A target="_blank" HREF=http://www.wopr.com/cgi-bin/w3t/showflat.pl?Cat=&Board=xl&Number=18997&page=12&vie w=collapsed&sb=5>This one</A> is quite Dizzying! <img src=/S/dizzy.gif border=0 alt=dizzy width=15 height=15>

    In reference to that thread tho.. I would like to add a progress bar to my code. My question is, how can I calculate the number of files that contain a specified string?

    I want to count the number of files that have similiar characterisitics in thier filenames. Each filename contains Initials, and the date. I want to count the number of files with the same initials.. any ideas? <img src=/S/smile.gif border=0 alt=smile width=15 height=15>

    Thanks in advance!
    <IMG SRC=http://www.wopr.com/w3tuserpics/Kel_sig.gif>
    Moderator:<font color=448800> Pix Place, Internet Explorer</font color=448800>
    <small>www.kvisions.com

  2. #2
    4 Star Lounger
    Join Date
    Jan 2001
    Location
    Kortrijk, Belgium
    Posts
    571
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Use the Instr command in your code.
    e.g.
    If InStr(1, FileArray(i), "HP") then
    Count_HP = Count_HP + 1
    end if

    I assume here that the names of your files are in the FileArray() array and that the running index is i.

  3. #3
    Silver Lounger
    Join Date
    Jan 2001
    Location
    Northern, California, USA
    Posts
    1,886
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Thanks Hans! but... <img src=/S/sad.gif border=0 alt=sad width=15 height=15>

    Here's my code:
    ***CODE START***
    Dim q As Variant
    q = InStr(1, FileArray(i), StrInitials)
    '-------
    With frmprogress
    .FrameProgress.Caption = Format(n / q, "0%")
    .lblprogress.Width = (221.25 / n) * n
    If n = q Then .lblprogress.Width = 221.25
    If n = q Then .FrameProgress.Caption = "100%"
    DoEvents
    ****CODE END****

    It's telling me that q is empty even after i've assigned it as instr(1, filearray(i), strInitials).. any ideas? [img]/forums/images/smilies/smile.gif[/img]
    <IMG SRC=http://www.wopr.com/w3tuserpics/Kel_sig.gif>
    Moderator:<font color=448800> Pix Place, Internet Explorer</font color=448800>
    <small>www.kvisions.com

  4. #4
    Silver Lounger
    Join Date
    Jan 2001
    Location
    Northern, California, USA
    Posts
    1,886
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Also...

    the InStr(1, FileArray(i), StrInitials) isn't properly counting all the files in the specified directory, (assigned to the sfolder variable in the main code...)

    Please help! <img src=/S/bow.gif border=0 alt=bow width=15 height=15> <img src=/S/dizzy.gif border=0 alt=dizzy width=15 height=15> <img src=/S/scream.gif border=0 alt=scream width=15 height=15>

    Thanks!
    <IMG SRC=http://www.wopr.com/w3tuserpics/Kel_sig.gif>
    Moderator:<font color=448800> Pix Place, Internet Explorer</font color=448800>
    <small>www.kvisions.com

  5. #5
    Silver Lounger
    Join Date
    Jan 2001
    Location
    Northern, California, USA
    Posts
    1,886
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Thanks Andrew!

    Do you have any insight on counting the number of files with similar names in a given directory? [hope]

    thanks again!
    <IMG SRC=http://www.wopr.com/w3tuserpics/Kel_sig.gif>
    Moderator:<font color=448800> Pix Place, Internet Explorer</font color=448800>
    <small>www.kvisions.com

  6. #6
    Gold Lounger
    Join Date
    Feb 2001
    Location
    Dublin, Ireland, Republic of
    Posts
    2,697
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Drk,

    can you be a little bit more specific, in what way are the file names similar. I take it that they share some naming convention you have devised. Do they start with the same descriptor or is the item they have in common in a particular position in the filename.?

    Andrew

  7. #7
    4 Star Lounger
    Join Date
    Jan 2001
    Location
    Kortrijk, Belgium
    Posts
    571
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Drk,

    The Instr command returns an integer, giving the position of the second string in the first. If this integer is different from zero, then the second string has been found in the first string. So, you need an extra variable to count for the number of times this happens. That's the reason for the Count_HP variable in my example.

  8. #8
    Silver Lounger
    Join Date
    Jan 2001
    Location
    Northern, California, USA
    Posts
    1,886
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    It's always ini-yyyy-mm-dd.xls.

    I'm using the initials string as a basis.. so I need to be able to count the number of files in a given directory so that the math is always correct on my progress bar... [img]/forums/images/smilies/wink.gif[/img]

    Thanks again!
    <IMG SRC=http://www.wopr.com/w3tuserpics/Kel_sig.gif>
    Moderator:<font color=448800> Pix Place, Internet Explorer</font color=448800>
    <small>www.kvisions.com

  9. #9
    Silver Lounger
    Join Date
    Jan 2001
    Location
    Northern, California, USA
    Posts
    1,886
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Hans,

    I'm having difficulties with the Count_HP = Count_HP + 1...

    I have to replace HP with a string, StrInitials... Count_(StrInitials) returns an error...

    After playing with it a bit, i've got my math doing the following:
    ***CODE START***
    With frmprogress
    .FrameProgress.Caption = Format(n / InStr(1, FileArray(i), StrInitials), "0%")
    .lblprogress.Width = (221.25 / InStr(1, FileArray(i), StrInitials)) * n
    If n = InStr(1, FileArray(i), StrInitials) Then .lblprogress.Width = 221.25
    If n = InStr(1, FileArray(i), StrInitials) Then .FrameProgress.Caption = "100%"
    DoEvents
    ****CODE END****

    The problem i'm having is InStr(1, FileArray(i), StrInitials) is returning a value of 28, while there are only 12 files with similiar initials in my example... (where is it getting 28 from??!)

    Thanks again for all your help! [img]/forums/images/smilies/smile.gif[/img]
    <IMG SRC=http://www.wopr.com/w3tuserpics/Kel_sig.gif>
    Moderator:<font color=448800> Pix Place, Internet Explorer</font color=448800>
    <small>www.kvisions.com

  10. #10
    Gold Lounger
    Join Date
    Feb 2001
    Location
    Dublin, Ireland, Republic of
    Posts
    2,697
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Hi Drk,

    I am assuming the the left most letters in the filename are what determines if the files are to be matched. (Why not group all the files concerned in the one sub-directory?).

    The following code returns the the number of files in a directory and then counts how many of those files start with a sequence as dfined in Init = "xxx", wheer xxx is the criteria. If it counts ok for you, you will need to adapt it to fit into your existing code.

    <pre>Sub GetFilesMatch()
    Dim FileName() As String
    Dim Directory As String
    Dim FileNumber As Integer
    Dim Init As String
    Dim InitMatch As Integer
    On Error Resume Next
    Directory = InputBox("Enter Directory to use : ", "List of Files in Directory")
    Init = "ini" '<font color=red> <-- insert string to search for here </font color=red>
    If Directory <> "" Then
    If Right(Directory, 1) <> "" Then
    Directory = Directory & ""
    End If
    File = Dir(Directory, vbNormal)
    Do While File <> ""
    FileNumber = FileNumber + 1
    File = Dir
    Loop
    MsgBox "The Directory " & Directory & " holds " & FileNumber & " Files"
    ReDim FileName(FileNumber)
    FileName(1) = Dir(Directory, vbNormal)
    Application.ScreenUpdating = False
    For fName = 2 To FileNumber
    FileName(fName) = Dir
    Next
    For fName = 1 To FileNumber
    If Left(FileName(fName), Len(Init)) = Init Then
    InitMatch = InitMatch + 1
    End If
    Next
    MsgBox "Number of matching files = " & InitMatch
    End If
    End Sub</pre>

    Hope it is of some help.

    Andrew

  11. #11
    Bronze Lounger
    Join Date
    Jun 2001
    Location
    New York, New York, Lebanon
    Posts
    1,449
    Thanks
    1
    Thanked 1 Time in 1 Post

    Re: Multiple Spreadsheets II

    DrkRealm

    My two cents, and PMFJI

    1) I think you should use the <font color=red> FileSearch </font color=red> and save yourself a lot of trouble. Check it out in the OLH.

    2) Use Instr and as Hans said before, it needs an Integer type, you have a Variant type which is OK, but an integer would be better.

    3) Loop through the list of files found by the FileSearch and compare it to what you need.

    Wassim
    <img src=/S/compute.gif border=0 alt=compute width=40 height=20> in the <img src=/S/bagged.gif border=0 alt=bagged width=22 height=22>

  12. #12
    Silver Lounger
    Join Date
    Jan 2001
    Location
    Northern, California, USA
    Posts
    1,886
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Hmm, interesting..

    I'm still a little unclear as how to make the FileSearch function return only the files within the past 20 days... I can't use the created on or modified date because these will always change. The date is in the file name itself, using the convention DATA-*USER*-01-01-2002.xls...

    Once I have a function which returns only those files, how can I open them?

    Perhaps you can kick me in the right direction? <img src=/S/wink.gif border=0 alt=wink width=15 height=15>
    <IMG SRC=http://www.wopr.com/w3tuserpics/Kel_sig.gif>
    Moderator:<font color=448800> Pix Place, Internet Explorer</font color=448800>
    <small>www.kvisions.com

  13. #13
    Silver Lounger
    Join Date
    Jan 2001
    Location
    Northern, California, USA
    Posts
    1,886
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Alright... This is working somewhat well, perhaps you can work your magic on this chunk of code:
    <pre>Public Sub process()
    <font color=blue>On Error Resume Next</font color=blue>
    Application.ScreenUpdating = False
    DoEvents
    Dim FileArray() As String
    Dim I As Integer
    Dim n As String
    n = 1
    Dim sFolder As String
    Do
    sFolder = "K:client_supporttrackingData"
    Dim FileName() As String
    Dim Directory As String
    Dim FileNumber As Integer
    Dim Init As String
    Dim InitMatch As Integer
    On Error Resume Next
    Directory = sFolder
    Init = "*" ' <-- insert string to search for here
    If Directory <> "" Then
    If Right(Directory, 1) <> "" Then
    Directory = Directory & ""
    End If
    File = Dir(Directory, vbNormal)
    Do While File <> ""
    FileNumber = FileNumber + 1
    File = Dir
    Loop
    ReDim FileName(FileNumber)
    FileName(1) = Dir(Directory, vbNormal)
    Application.ScreenUpdating = False
    For fName = 2 To FileNumber
    FileName(fName) = Dir
    Next
    For fName = 1 To FileNumber
    If Left(FileName(fName), Len(Init)) = Init Then
    InitMatch = InitMatch + 1
    x = FileNumber
    End If
    Next
    End If
    Dim strFDate As String
    strFDate = FileArray(I)
    strFDate = Left(strFDate, InStr(strFDate, ".") - 1)
    strFDate = Right(strFDate, Len(strFDate) - InStr(strFDate, "-"))
    If DateValue(strFDate) > Date - 30 Then
    GoTo NextOne
    Else
    GoTo Here
    End If
    NextOne:
    WsCompiler = ActiveWorkbook.Name
    History.Range("A" & 65000).Copy
    Selection.End(xlUp).Select
    r = Selection.Row
    Loop Until sFolder <> ""
    ReDim FileArray(0)
    FindFiles sFolder, FileArray(), "*" & "*.xls"
    For I = 1 To UBound(FileArray)
    Label1.Caption = "Processing " & FileArray(I) & "..."
    DoEvents
    WsRepSheet = ActiveWorkbook.Name
    If Main.Range("AG" & 2).Value = "0:00:00" Then Call ColFix
    n = n + 1
    Application.DisplayAlerts = False
    Windows(WsRepSheet).Activate
    Cells.Select
    Selection.EntireColumn.Hidden = False
    Main.Activate
    Range("A" & 65000).Select
    Selection.End(xlUp).Select
    q = Selection.Row
    Main.Activate
    Range("A2:AZ" & q).Copy
    Windows(WsRepSheet).Close
    Windows(WsCompiler).Activate
    History.Activate
    Range("A" & r).PasteSpecial
    r = r + q
    <font color=448800>''do something with returned filename (open it, take out the data you need,
    'close it, put the data in a common worksheet, etc.)</font color=448800>
    'End With
    Dim arg3
    arg3 = Format(n / (FileNumber), "0%")
    FrameProgress.Caption = arg3
    lblprogress.Width = (314.95 / (FileNumber)) * n
    If n = (FileNumber) Then lblprogress.Width = 314.95
    If n = (FileNumber) Then FrameProgress.Caption = "95%"
    DoEvents
    Here:
    Next I
    History.Activate
    Call OrgBlanks
    Call DeleteDups
    Label1.Caption = "History Compiled"
    lblprogress.Width = 314.95

    FrameProgress.Caption = "100%"
    DoEvents
    Label1.Caption = "System Ready"
    FrameProgress.Caption = ""
    DoEvents
    End Sub
    </pre>

    I'm sure there's a bunch of stuff in there I don't need, essentially what it does is run through the contents of said directory, opens each file within that directory, and copies the contents of the workbooks within that directory to a sheet associated with this workbook. If you notice the point where I dim StrFDate is where i'm trying to open and pull only from files which were created in the past 20 days. Anything older than that is not important.

    I guess what i'm looking for here is some guidance on how to optimize the code. The current process runs through 150+ workbooks, and takes a good 10 minutes to complete. At times, the process will encounter an unrecoverable error and crash the entire excel session. <img src=/S/help.gif border=0 alt=help width=23 height=15>

    Thanks for all your input!
    <IMG SRC=http://www.wopr.com/w3tuserpics/Kel_sig.gif>
    Moderator:<font color=448800> Pix Place, Internet Explorer</font color=448800>
    <small>www.kvisions.com

  14. #14
    Gold Lounger
    Join Date
    Feb 2001
    Location
    Dublin, Ireland, Republic of
    Posts
    2,697
    Thanks
    1
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Drk,

    There is quite a lot of code there. To break things down a bit, and if you have no objection to the FileSystemObject the following code should select all files in the given folder that are named as being less than 20 days old - and assumes all your files conform strictly to your ini-yyyy-mm-dd.xls namimg convention. (well it skips files that do not start twith "ini").<pre>Sub ProcessFiles()
    Dim oFSO, oFldr, oFile, i As Long
    i = 0
    Set oFSO = CreateObject("Scripting.FileSystemObject")
    Set oFldr = oFSO.GetFolder("K:client_supporttrackingData")
    For Each oFile In oFldr.Files
    If Left(oFile.Name, 3) = "ini" And _
    Int(Now) - DateValue(Mid(oFile.Name, 5, 10)) < 20 Then<font color=448800>
    '
    ' process files less than 20 days old here
    '</font color=448800>
    i = i + 1
    End If
    Next
    MsgBox i & " Files Processed"
    Set fso = Nothing
    Set fldr = Nothing
    End Sub</pre>

    I have not included any processing code, and if the above starts to meet your requirements and you want help with that please post back. Also if I missed some important aspect of your code let me know.

    Andrew

  15. #15
    Silver Lounger
    Join Date
    Jan 2001
    Location
    Northern, California, USA
    Posts
    1,886
    Thanks
    0
    Thanked 0 Times in 0 Posts

    Re: Multiple Spreadsheets II

    Wow, looks much better!

    It's choking on this line:
    If Left(oFile.Name, 3) = fOSUserName And Int(Now) - DateValue(Mid(oFile.Name, 5, 10)) < 20 Then

    Type Mismatch...

    I don't recognize enough of this code to effect any fix, perhaps you can help me out here?
    <IMG SRC=http://www.wopr.com/w3tuserpics/Kel_sig.gif>
    Moderator:<font color=448800> Pix Place, Internet Explorer</font color=448800>
    <small>www.kvisions.com

Page 1 of 2 12 LastLast

Posting Permissions

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