Application.filesearch replacement 2010/i365

P

pocquet

Board Regular
Joined
Aug 21, 2013
Messages
118
Hi Guys,

We are migrating to 2010 shortly followed by I365 from office 2003.

I am having a few issues with the following code and Application.filesearch does not exsist.

Code: 
Sub Outsource_Import()

With Application.FileSearch
        .NewSearch
        .LookIn = "U:\Source\"
        .FileName = "Daily_Weekly_Performance_Report_0000000*"
        If .Execute(SortBy:=msoSortByLastModified, SortOrder:=msoSortOrderDescending) > 0 Then
            FileCopy .FoundFiles(1), "X:\Customer Services\Pre_01.txt"
        End If

This code looks for a file name, then copys it into a specified folder.

There are 15 files this happens to.

The date/time must be sorted by last modified.

Any ideas?

Thanks

Jon
 

Excel Facts

Save Often
If you start asking yourself if now is a good time to save your Excel workbook, the answer is Yes
Sort by date Sort by votes
Hi SydneyGeek, Thanks for your reply.

Sorry for the late reply been having a few nightmares here!.

The problem I have is I need the latest instance of a file that contains the beginning of the file name.

The file names are fully called:

Code: 
Daily_Weekly_Performance_Report_0000014_20131009_080630

The first set of Numbers is the file type and what it contains, the next is the date and the last one is the time its generated.

I am interested in capturing only the latest instance of a file so If I run the code at 20:10 I pick up the files that are sent at 20:00

Thanks

Jon
 
Upvote 0
SydneyGeek said:
I haven't used them before but Dir takes parameters. One of those is sort order.
See: Microsoft Corporation

Denis
Click to expand...

Hi Denis,

I am going a bit mad here,

Your link looks good but its not the version of the 'DIR' I seem to have. The only Parameters I can put in are to do with the file status eg VBNormal or VBreadonly etc.

No sign of using a time etc

I have tried using filesystemobject

Code: 
Sub Copy_Outsource()     
    Dim FSO As Object
    Dim FromPath As String
    Dim ToPath As String
    Dim FileName As String
    
    FromPath = "u:\outsource\Source\"  
    ToPath = "X:\Customer Services\Central MI\Reporting\Intraday Reporting\Outsource\"   
    FileName = "Daily_Weekly_Performance_Report_0000000*"  
    
    Set FSO = CreateObject("scripting.filesystemobject")
       
    
    FSO.CopyFile Source:=FromPath & FileName, Destination:=ToPath
   
  
End Sub

This copy's all the files for me but not the latest instance of it.

I've been sat here since 07:30 am (now 1300) on this one and my brains starting to dribble out my ears :(

Thanks for all your help

Jon
 
Upvote 0
Lightly tested, but try this (it might be a little clumsy but we can do our own sorting):

Code: 
[COLOR="Navy"]Sub[/COLOR] Copy_Outsource()
[COLOR="Navy"]Dim[/COLOR] FSO [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR] [COLOR="SeaGreen"]'Scripting.FileSystemObject[/COLOR]
[COLOR="Navy"]Dim[/COLOR] srcFolder [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] destFolder [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] sSearchFor [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] f [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR] [COLOR="SeaGreen"]'Scripting.File[/COLOR]
[COLOR="Navy"]Dim[/COLOR] dic [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Object[/COLOR] [COLOR="SeaGreen"]'Scripting.Dictionary[/COLOR]
[COLOR="Navy"]Dim[/COLOR] a

    srcFolder = "C:\myTemp\"         [COLOR="SeaGreen"]'//Include a trailing backslash[/COLOR]
    destFolder = "C:\myTemp\Test\"   [COLOR="SeaGreen"]'//Include a trailing backslash[/COLOR]
    
    sSearchFor = "Book2013*"         [COLOR="SeaGreen"]'//remember asterisk here[/COLOR]
    
    
    [COLOR="SeaGreen"]'//Iterate files to find matches[/COLOR]
    [COLOR="Navy"]Set[/COLOR] dic = CreateObject("Scripting.Dictionary")
    [COLOR="Navy"]Set[/COLOR] FSO = CreateObject("Scripting.FileSystemObject")
    [COLOR="Navy"]For[/COLOR] [COLOR="Navy"]Each[/COLOR] f [COLOR="Navy"]In[/COLOR] FSO.GetFolder(srcFolder).Files
        [COLOR="Navy"]If[/COLOR] f.Name [COLOR="Navy"]Like[/COLOR] sSearchFor [COLOR="Navy"]Then[/COLOR]
            dic.Add f.Name, ""
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    [COLOR="Navy"]Next[/COLOR] f
    a = dic.Keys
    [COLOR="SeaGreen"]'//Sort[/COLOR]
    [COLOR="Navy"]Call[/COLOR] BubbleSort(a)
    [COLOR="Navy"]Debug[/COLOR].[COLOR="Navy"]Print[/COLOR] a(UBound(a))
    
    [COLOR="SeaGreen"]'//Copy latest file[/COLOR]
    FSO.CopyFile Source:=srcFolder & a(UBound(a)), Destination:=destFolder & a(UBound(a))
   
  
[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]

[COLOR="Navy"]Sub[/COLOR] BubbleSort(ByRef a)
[COLOR="Navy"]Dim[/COLOR] Temp [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]String[/COLOR]
[COLOR="Navy"]Dim[/COLOR] i [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Integer[/COLOR]
[COLOR="Navy"]Dim[/COLOR] NoExchanges [COLOR="Navy"]As[/COLOR] [COLOR="Navy"]Boolean[/COLOR]

[COLOR="Navy"]Do[/COLOR]
    NoExchanges = True
    [COLOR="Navy"]For[/COLOR] i = LBound(a) [COLOR="Navy"]To[/COLOR] UBound(a) - 1
        [COLOR="Navy"]If[/COLOR] a(i) > a(i + 1) [COLOR="Navy"]Then[/COLOR]
            NoExchanges = False
            Temp = a(i)
            a(i) = a(i + 1)
            a(i + 1) = Temp
        [COLOR="Navy"]End[/COLOR] [COLOR="Navy"]If[/COLOR]
    [COLOR="Navy"]Next[/COLOR] i

[COLOR="Navy"]Loop[/COLOR] [COLOR="Navy"]While[/COLOR] [COLOR="Navy"]Not[/COLOR] NoExchanges

[COLOR="Navy"]End[/COLOR] [COLOR="Navy"]Sub[/COLOR]
 
Upvote 0
Xenou Fab works like a charm more than happy with it.

I just need to have it rename the file when it copys.

Because I need to run this for more than one file (15 files in total) do I simply need to re-create the first sub for each file or am I able to combine it into one sub with some kind of clause?

Really appreciate both of your help so far!

Thanks

Jon
 
Upvote 0
Hi Guys,

This is my final code: this allows for renaming and multiple files to be moved:

Code: 
Sub Copy_Outsource1()Dim FSO As Object 'Scripting.FileSystemObject
Dim srcFolder As String
Dim destFolder As String
Dim sSearchFor(0 To 14) As String
Dim f As Object 'Scripting.File
Dim dic As Object 'Scripting.Dictionary
Dim a
Dim NewFile(0 To 14) As String
Dim num As Integer


'Search For Array put file names here'
    sSearchFor(0) = "File1*"         '//remember asterisk here
    sSearchFor(1) = "file2*"         '//remember asterisk here
    sSearchFor(2) = "file3"         '//remember asterisk here
    
    
'New File names Array new names must be same order as source file name array


    NewFile(0) = "new1.txt"
    NewFile(1) = "new2..txt"
    NewFile(2) = "new3.03.txt"
    


    srcFolder = "C:\temp\"         '//Include a trailing backslash
    destFolder = "c:\temp\dest\"   '//Include a trailing backslash
    
 For num = LBound(sSearchFor) To UBound(sSearchFor)


    
    '//Iterate files to find matches
    Set dic = CreateObject("Scripting.Dictionary")
    Set FSO = CreateObject("Scripting.FileSystemObject")
    For Each f In FSO.GetFolder(srcFolder).Files
        If f.Name Like sSearchFor(num) Then
            dic.Add f.Name, ""
        End If
    Next f
    a = dic.Keys
    '//Sort
    Call BubbleSort(a)
    Debug.Print a(UBound(a))
    
    '//Copy latest file
    FSO.CopyFile Source:=srcFolder & a(UBound(a)), Destination:=destFolder & NewFile(num)
    
Next


   
  
End Sub


Sub BubbleSort(ByRef a)
Dim Temp As String
Dim i As Integer
Dim NoExchanges As Boolean


Do
    NoExchanges = True
    For i = LBound(a) To UBound(a) - 1
        If a(i) > a(i + 1) Then
            NoExchanges = False
            Temp = a(i)
            a(i) = a(i + 1)
            a(i + 1) = Temp
        End If
    Next i


Loop While Not NoExchanges


End Sub

Thanks allot.
 
Upvote 0
Yeah - old thread but new problem for me.

I'm not a VBA guy, I have recorded Macros and such in the past and edited some VBA code before but this is killing me. My site just updated their MS products to 2013 and this was written for 2003 so the FIlesearch option doesn't work. I know this needs to be updated but I have NO idea how.

Here is the code:

Code: 
With Application.FileSearch
        .LookIn = p
        .Filename = "*.*"
        If .Execute() > 0 Then
            For i = 1 To .FoundFiles.Count
                NumberofRuns = .FoundFiles.Count
                Filename = .FoundFiles(i)
                
                Sheets("GM Template").Copy After:=Sheets(i + 2 + k)
                Sheets("GM Template (2)").Name = "GM Table " & i
                Sheets("S&H Template").Copy After:=Sheets(i + 3 + k)
                Sheets("S&H Template (2)").Name = "S&H Run " & i
                
                Workbooks.OpenText Filename:=Filename _
                    , Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
                    :=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:= _
                    False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
                MyReport = ActiveWorkbook.Name
                Range("A1").Select
                Selection.End(xlDown).Select
                RowEnd = ActiveCell.Row
                Range("A1").Select
                Selection.End(xlToRight).Select
                ColumnEnd = ActiveCell.Column
                Range(Cells(1, 1), Cells(RowEnd, ColumnEnd)).Select
                Cells.Select
                Selection.Sort Key1:=Range(SearchColumn), Order1:=xlAscending, Key2:=Range("A2") _
                    , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
                    , Orientation:=xlTopToBottom
                Range(Cells(1, 1), Cells(RowEnd, ColumnEnd)).Copy
                Windows(MyBook).Activate
                Sheets("GM Table " & i).Select
                Range("A1").Select
                ActiveSheet.Paste
                
                Windows(MyReport).Activate
                Application.DisplayAlerts = False
                ActiveWorkbook.Close
            
                If DyeSet = "DS33" Then
                    Call DS33
                ElseIf DyeSet = "DS30" Then
                    Call DS30
                ElseIf DyeSet = "Identifiler" Then
                    Call Identifiler
                ElseIf DyeSet = "ProPlus" Then
                    Call ProPlus
                ElseIf DyeSet = "SNaPshot" Then
                    Call SNaPshot
                ElseIf DyeSet = "ALFP" Then
                    Call ALFP
                End If
                
                k = k + 1
                
                Sheets("S&H Summary").Select
                Range("B4").Select
                If ActiveCell.Value <> False Then
                    Selection.End(xlToRight).Select
                    ColumnTracker = ActiveCell.Column
                    PasteColumn = ColumnTracker + 1
                Else
                    PasteColumn = 2
                End If
                
                Sheets("S&H Run " & i).Select
                Range("B2:C34").Copy
                Sheets("S&H Summary").Select
                Cells(4, PasteColumn).Select
                Selection.PasteSpecial Paste:=xlValues
                Selection.NumberFormat = "0.00"
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                Cells(3, PasteColumn).Value = "Run " & i
                
                If CapFlag <> 0 Then
                    Cells(2, PasteColumn).Select
                    With Selection.Interior
                        .ColorIndex = 6
                        .Pattern = xlSolid
                    End With
                    Cells(2, PasteColumn).Value = CapFlag
                ElseIf MissingFlag <> 0 Then
                    Cells(1, PasteColumn).Select
                    With Selection.Interior
                        .ColorIndex = 46
                        .Pattern = xlSolid
                    End With
                    Cells(1, PasteColumn).Value = MissingFlag
                End If
                
                For j = 5 To 5 + UBound(Alleles)
                    Cells(j, PasteColumn + 1).Select
                    If IsNumeric(ActiveCell.Value) = False Then
                        Range(Cells(j, PasteColumn), Cells(j, PasteColumn + 1)).Select
                        Selection.ClearContents
                        With Selection.Interior
                            .ColorIndex = 3
                            .Pattern = xlSolid
                        End With
                    ElseIf ActiveCell.Value >= Precision Then
                        With Selection.Interior
                            .ColorIndex = 3
                            .Pattern = xlSolid
                        End With
                    End If
                Next j
                
                Sheets("S&H Run " & i).Select
                Range("D2:E34").Copy
                Sheets("S&H Summary").Select
                Cells(39, PasteColumn).Select
                Selection.PasteSpecial Paste:=xlValues
                Selection.NumberFormat = "0.0"
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                Cells(38, PasteColumn).Value = "Run " & i
                
                For j = 40 To 40 + UBound(Alleles)
                    Cells(j, PasteColumn).Select
                    If IsNumeric(ActiveCell.Value) = False Then
                        Range(Cells(j, PasteColumn), Cells(j, PasteColumn + 1)).Select
                        Selection.ClearContents
                        With Selection.Interior
                            .ColorIndex = 3
                            .Pattern = xlSolid
                        End With
                    ElseIf ActiveCell.Value <= 150 And ActiveCell.Value <> "" And DyeSet <> "ALFP" Then
                        With Selection.Interior
                            .ColorIndex = 3
                            .Pattern = xlSolid
                        End With
                    End If
                Next j
                
                Cells(73, PasteColumn).Value = MyReport
                
            Next i
        Else
            MsgBox ("Empty Folder")
            Exit Sub
        End If
    End With


    If DyeSet = "DS33" Then
        Call DS33Summary
    ElseIf DyeSet = "DS30" Then
        Call DS30Summary
    ElseIf DyeSet = "Identifiler" Then
        Call IdentifilerSummary
    ElseIf DyeSet = "ProPlus" Then
        Call ProPlusSummary
    ElseIf DyeSet = "SNaPshot" Then
        Call SNaPshotSummary
    ElseIf DyeSet = "ALFP" Then
        Call ALFPSummary
    End If


End Sub


Can anyone help out?
 
Upvote 0
rewritten with a different filesearch method:

Only changes made are between the ugly ######## lines - everything before/after is untouched.

Code: 
'############################################################################################################################################
Dim objFSO As Object    'Scripting.FileSystemObject
Dim fldr As Object      'Scripting.Folder
Dim f As Object         'Scripting.File

Set objFSO = CreateObject("Scripting.FileSystemObject")

With objFSO
        Set fldr = .GetFolder(p)
        If fldr.Files.Count > 0 Then
            
            NumberofRuns = fldr.Files.Count
            For Each f In fldr.Files
                
                i = i + 1         '//pretend we are in a [for i = 1 to x loop], instead of a [for each loop]
                Filename = f.Path '//use f.Path to get full path to file (C:\folder\file.txt), use f.Name to get just name of file (file.txt)
                '############################################################################################################################
                
                Sheets("GM Template").Copy After:=Sheets(i + 2 + k)
                Sheets("GM Template (2)").Name = "GM Table " & i
                Sheets("S&H Template").Copy After:=Sheets(i + 3 + k)
                Sheets("S&H Template (2)").Name = "S&H Run " & i
                
                Workbooks.OpenText Filename:=Filename _
                    , Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
                    :=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:= _
                    False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
                MyReport = ActiveWorkbook.Name
                Range("A1").Select
                Selection.End(xlDown).Select
                RowEnd = ActiveCell.Row
                Range("A1").Select
                Selection.End(xlToRight).Select
                ColumnEnd = ActiveCell.Column
                Range(Cells(1, 1), Cells(RowEnd, ColumnEnd)).Select
                Cells.Select
                Selection.Sort Key1:=Range(SearchColumn), Order1:=xlAscending, Key2:=Range("A2") _
                    , Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
                    , Orientation:=xlTopToBottom
                Range(Cells(1, 1), Cells(RowEnd, ColumnEnd)).Copy
                Windows(MyBook).Activate
                Sheets("GM Table " & i).Select
                Range("A1").Select
                ActiveSheet.Paste
                
                Windows(MyReport).Activate
                Application.DisplayAlerts = False
                ActiveWorkbook.Close
            
                If DyeSet = "DS33" Then
                    Call DS33
                ElseIf DyeSet = "DS30" Then
                    Call DS30
                ElseIf DyeSet = "Identifiler" Then
                    Call Identifiler
                ElseIf DyeSet = "ProPlus" Then
                    Call ProPlus
                ElseIf DyeSet = "SNaPshot" Then
                    Call SNaPshot
                ElseIf DyeSet = "ALFP" Then
                    Call ALFP
                End If
                
                k = k + 1
                
                Sheets("S&H Summary").Select
                Range("B4").Select
                If ActiveCell.Value <> False Then
                    Selection.End(xlToRight).Select
                    ColumnTracker = ActiveCell.Column
                    PasteColumn = ColumnTracker + 1
                Else
                    PasteColumn = 2
                End If
                
                Sheets("S&H Run " & i).Select
                Range("B2:C34").Copy
                Sheets("S&H Summary").Select
                Cells(4, PasteColumn).Select
                Selection.PasteSpecial Paste:=xlValues
                Selection.NumberFormat = "0.00"
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                Cells(3, PasteColumn).Value = "Run " & i
                
                If CapFlag <> 0 Then
                    Cells(2, PasteColumn).Select
                    With Selection.Interior
                        .ColorIndex = 6
                        .Pattern = xlSolid
                    End With
                    Cells(2, PasteColumn).Value = CapFlag
                ElseIf MissingFlag <> 0 Then
                    Cells(1, PasteColumn).Select
                    With Selection.Interior
                        .ColorIndex = 46
                        .Pattern = xlSolid
                    End With
                    Cells(1, PasteColumn).Value = MissingFlag
                End If
                
                For j = 5 To 5 + UBound(Alleles)
                    Cells(j, PasteColumn + 1).Select
                    If IsNumeric(ActiveCell.Value) = False Then
                        Range(Cells(j, PasteColumn), Cells(j, PasteColumn + 1)).Select
                        Selection.ClearContents
                        With Selection.Interior
                            .ColorIndex = 3
                            .Pattern = xlSolid
                        End With
                    ElseIf ActiveCell.Value >= Precision Then
                        With Selection.Interior
                            .ColorIndex = 3
                            .Pattern = xlSolid
                        End With
                    End If
                Next j
                
                Sheets("S&H Run " & i).Select
                Range("D2:E34").Copy
                Sheets("S&H Summary").Select
                Cells(39, PasteColumn).Select
                Selection.PasteSpecial Paste:=xlValues
                Selection.NumberFormat = "0.0"
                Selection.Borders(xlDiagonalDown).LineStyle = xlNone
                Selection.Borders(xlDiagonalUp).LineStyle = xlNone
                With Selection.Borders(xlEdgeLeft)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeTop)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeBottom)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlEdgeRight)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlInsideVertical)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                With Selection.Borders(xlInsideHorizontal)
                    .LineStyle = xlContinuous
                    .Weight = xlThin
                    .ColorIndex = xlAutomatic
                End With
                Cells(38, PasteColumn).Value = "Run " & i
                
                For j = 40 To 40 + UBound(Alleles)
                    Cells(j, PasteColumn).Select
                    If IsNumeric(ActiveCell.Value) = False Then
                        Range(Cells(j, PasteColumn), Cells(j, PasteColumn + 1)).Select
                        Selection.ClearContents
                        With Selection.Interior
                            .ColorIndex = 3
                            .Pattern = xlSolid
                        End With
                    ElseIf ActiveCell.Value <= 150 And ActiveCell.Value <> "" And DyeSet <> "ALFP" Then
                        With Selection.Interior
                            .ColorIndex = 3
                            .Pattern = xlSolid
                        End With
                    End If
                Next j
                
                Cells(73, PasteColumn).Value = MyReport
                
            Next i
        Else
            MsgBox ("Empty Folder")
            Exit Sub
        End If
    End With


    If DyeSet = "DS33" Then
        Call DS33Summary
    ElseIf DyeSet = "DS30" Then
        Call DS30Summary
    ElseIf DyeSet = "Identifiler" Then
        Call IdentifilerSummary
    ElseIf DyeSet = "ProPlus" Then
        Call ProPlusSummary
    ElseIf DyeSet = "SNaPshot" Then
        Call SNaPshotSummary
    ElseIf DyeSet = "ALFP" Then
        Call ALFPSummary
    End If


End Sub
 
Last edited:
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Question
With Application.FileSearch how do I replace
Replies
8
Views
761
ddavis5891
D
S
  • Question
Set fs = Application.FileSearch 'does not work in 2007
Replies
1
Views
628
Fluff
Fluff
M
  • Question
Importing Multiple TXT Files
Replies
1
Views
535
Fluff
Fluff
H
  • Question
Excel 2010: VBA How to replace Application.FileSearch
Replies
0
Views
3K
Hitchy
H
L
  • Question
VBA to recurse subdirectories and list file information
Replies
0
Views
2K
lionelnz
L

Forum statistics

Threads
1,221,783
Messages
6,161,940
Members
451,730
Latest member
BudgetGirl

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top