Solved

DIR issue

Posted on 2016-08-29
7
54 Views
Last Modified: 2016-08-31
myfile = Dir(ippath & "*.xlsm")
myfile1 = Dir(ippath1 & "*.xlsx")
Do While myfile <> ""
Do While myfile1 <> ""
loop
loop
end sub

I used 2 DIR, like the above, my issue was, one finish myfile1 DIR working inside the myfile DIR, it will not get myfile DIR another file, wrongly go to myfile1 DIR
0
Comment
Question by:bala kumaran
  • 5
7 Comments
 
LVL 26

Expert Comment

by:ProfessorJimJam
ID: 41774811
what is your complete code? if possible can you please post your complete sub routine?
0
 

Author Comment

by:bala kumaran
ID: 41774812
Public Sub Insert()

Dim myfile As String
Dim myfile1 As Variant
ippath = Sheet1.TextBox1.Text
ippath1 = Sheet1.TextBox2.Text
myfile = Dir(ippath & "*.xlsm")
myfile1 = Dir(ippath1 & "*.xlsx")

Do While myfile <> ""

    Workbooks.Open FileName:=ippath & myfile, UpdateLinks:=True
    Application.DisplayAlerts = False

    Sheets("Minimum Accounts Work Tracker").Select
   
    If Sheet1.OptionButton1.Value = True Then
   
    Rows("4:4").Select
    Cells.Find(What:="low").Activate
    ActiveCell.Offset(0, -2).Select
    ActiveCell = Sheet1.TextBox6.Text
    ActiveCell.Offset(-1, 0).Select
    ActiveCell.FormulaR1C1 = "=IFERROR(CHOOSE(WEEKDAY(R[1]C,1),""Sun"",""Mon"",""Tue"",""Wed"",""Thu"",""Fri""),"""")"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveCell.Offset(2, 0).Select
    ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,Priority!C1:C4,4,0),"""")"
    Selection.Copy
    Addrs = Split(ActiveCell.Address, "$")(1)
    RcNt = ActiveSheet.UsedRange.Rows.Count
    Range(Addrs & "5:" & Addrs & RcNt).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("i5").Select
    Selection.PasteSpecial Paste:=xlPasteValues
   
    End If
   
           
    If Sheet1.OptionButton3.Value = True Then
         
        Do While myfile1 <> ""
       
    Workbooks.Open FileName:=ippath1 & myfile1, UpdateLinks:=True
    m1 = ActiveWorkbook.Name
    Range("a2:l" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.Copy
    Windows(myfile).Activate
    Sheets("Priority").Select
    Range("a2").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("A:A").Select
    Selection.TextToColumns DataType:=xlDelimited
    Range("a1").Select
    Sheets("Minimum Accounts Work Tracker").Select
    Range("bd4").Select
   
    If ActiveCell.Value = "" Then
    Rows("4:4").Select
    Cells.Find(What:="low").Activate
    ActiveCell.Offset(0, -2).Select
    ActiveCell = Sheet1.TextBox6.Text
    ActiveCell.Offset(-1, 0).Select
    ActiveCell.FormulaR1C1 = "=IFERROR(CHOOSE(WEEKDAY(R[1]C,1),""Sun"",""Mon"",""Tue"",""Wed"",""Thu"",""Fri""),"""")"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveCell.Offset(2, 0).Select
    ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,Priority!C1:C4,4,0),"""")"
    Selection.Copy
    Addrs = Split(ActiveCell.Address, "$")(1)
    RcNt = ActiveSheet.UsedRange.Rows.Count
    Range(Addrs & "5:" & Addrs & RcNt).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Else
   
    Rows("4:4").Select
    Cells.Find(What:="low").Activate
    ActiveCell.Offset(0, -1).Select
    Columns(ActiveCell.Column).Insert
   
    ActiveCell.formula = Split(myfile1, ".")(0)
    ActiveCell.Offset(-1, 0).Select
    ActiveCell.FormulaR1C1 = "=IFERROR(CHOOSE(WEEKDAY(R[1]C,1),""Sun"",""Mon"",""Tue"",""Wed"",""Thu"",""Fri""),"""")"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveCell.Offset(2, 0).Select
    ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,Priority!C1:C4,4,0),"""")"
    Selection.Copy
    Addrs = Split(ActiveCell.Address, "$")(1)
    RcNt = ActiveSheet.UsedRange.Rows.Count
    Range(Addrs & "5:" & Addrs & RcNt).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("i5").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    End If
    Windows(m1).Close
    myfile1 = Dir()
 
   
        Loop
         
    End If
   
       
    If Sheet1.OptionButton2.Value = True Or Sheet1.OptionButton4.Value = True Then
       
    Rows("4:4").Select
    Cells.Find(What:="low").Activate
    ActiveCell.Offset(0, -1).Select
    Columns(ActiveCell.Column).Insert
    ActiveCell = Sheet1.TextBox6.Text
    ActiveCell.Offset(-1, 0).Select
    ActiveCell.FormulaR1C1 = "=IFERROR(CHOOSE(WEEKDAY(R[1]C,1),""Sun"",""Mon"",""Tue"",""Wed"",""Thu"",""Fri""),"""")"
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveCell.Offset(2, 0).Select
    ActiveCell.FormulaR1C1 = "=IFERROR(VLOOKUP(RC4,Priority!C1:C4,4,0),"""")"
    Selection.Copy
    Addrs = Split(ActiveCell.Address, "$")(1)
    RcNt = ActiveSheet.UsedRange.Rows.Count
    Range(Addrs & "5:" & Addrs & RcNt).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("i5").Select
    Selection.PasteSpecial Paste:=xlPasteValues
    End If
 
   
    Rows("4:4").Select
    Cells.Find(What:="low").Activate
    Addrs1 = Split(ActiveCell.Address, "$")(1)
    ActiveCell.Offset(0, 8).Select
    Addrs2 = Split(ActiveCell.Address, "$")(1)
    RcNt = ActiveSheet.UsedRange.Rows.Count
    ActiveCell.Offset(-3, 0).Select
    Range(ActiveCell, ActiveCell.Offset(0, -8)).Select
    Selection.Copy
    Range(Addrs1 & "5:" & Addrs2 & RcNt).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    ActiveCell.Offset(0, 4).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.TextToColumns DataType:=xlDelimited
   
    Range("f1").Select
    Selection.Copy
    Range("f5:f" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Selection.Replace What:="1/0/1900", Replacement:=""
    Range("h1").Select
    Selection.Copy
    Range("h5:h" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
   
    Rows("4:4").Select
    Cells.Find(What:="low").Activate
    ActiveCell.Offset(1, 9).Select
    Addrs3 = Split(ActiveCell.Address, "$")(1)
    RcNt = ActiveSheet.UsedRange.Rows.Count
    ActiveCell.FormulaR1C1 = "=IF(R[0]C8=""Not Worked"","""",TODAY()-R[0]C8)"
    Selection.Copy
    Range(Addrs3 & "5:" & Addrs3 & RcNt).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("f5").Select
       
    If Sheet1.OptionButton1.Value = True Or Sheet1.OptionButton2.Value = True Then
    Range("d1").Select
    Selection.ClearContents
    Range("G2").Select
    Selection.Copy
    Range("g5:g" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("f5").Select
    End If
       
    If Sheet1.OptionButton3.Value = True Then
    Range("d1").Select
    ActiveCell = Sheet1.TextBox6.Text
    Range("G2").Select
    Selection.Copy
    Range("g5:g" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("f5").Select
    End If
   
    If Sheet1.OptionButton4.Value = True Then
    Range("G4").Activate
    Rows("4:4").Select
    Selection.AutoFilter
    ActiveSheet.Range("a4:cz" & ActiveSheet.UsedRange.Rows.Count).AutoFilter Field:=7, Criteria1:=Array( _
        "Cleared", "Required", "Required 2", "="), Operator:=xlFilterValues
    Range("G1").Select
    Selection.Copy
    Range("g5:g" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Range("f5").Select
    End If
    Sheets("schools").Select
    Range("f1:h1").Select
    Selection.Copy
    Range("f5:h" & ActiveSheet.UsedRange.Rows.Count).Select
    Selection.PasteSpecial Paste:=xlPasteFormulas
    Selection.Copy
    Selection.PasteSpecial Paste:=xlPasteValues
    Rows("1:1").Select
    Selection.EntireRow.Hidden = True
    Range("f5").Select
    Sheets("Minimum Accounts Work Tracker").Select
    Rows("1:1").Select
    Selection.EntireRow.Hidden = True
    Range("f5").Select
    Sheets("Progress Table").Select
    Range("A1").Select
    Sheets("FSCM RawData").Visible = False
    Sheets("2nd BPO").Visible = False
    Sheets("Priority").Visible = False
    Sheets("LIST").Visible = False
    ActiveWorkbook.Save
    ActiveWindow.Close
    Range("a1").Select

myfile = Dir()

Loop


'Call Binary
End Sub
0
 

Author Comment

by:bala kumaran
ID: 41774814
others work good,check   after  If Sheet1.OptionButton3.Value = True Then
0
Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

 

Author Comment

by:bala kumaran
ID: 41774933
any updation on this friends
0
 
LVL 76

Accepted Solution

by:
GrahamSkan earned 500 total points
ID: 41775008
Only one Dir() in a project can be active at a time.
It isn't clear why you are looking for similar extensions in a nested search. Perhaps you could look for ".xls*" in this case
Otherwise make a list for the outer loop and then work through the list

Sub Dirlistt()
    Dim strTemplates() As String
    Dim i As Integer
    Dim j As Integer
    
    MyFile = Dir(ippath & "*.xlsm")
    Do While MyFile <> ""
        ReDim Preserve strTemplates(i)
        strTemplates(i) = MyFile
        i = i + 1
        MyFile = Dir()
    Loop
    
    For j = 0 To i - 1
        MyFile = strTemplates(j)
        MyFile1 = Dir(ippath1 & "*.xlsx")
        Do While MyFile1 <> ""
            ''' process myfile1 in relation to myfile
            MyFile1 = Dir()
        Loop
    Next j
End Sub

Open in new window

0
 

Author Closing Comment

by:bala kumaran
ID: 41775015
great thanks
0
 

Author Comment

by:bala kumaran
ID: 41777936
Dear Experts,

could please let me know how to use For, Next for getting files


regards
Bala A
0

Featured Post

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Suggested Solutions

Title # Comments Views Activity
excel formatting with conditional formatting 2 42
Excel formula with two ifs 9 27
Excel Split Employee Name into Lname Fname Mname 3 15
Excel VBA 30 38
Since upgrading to Office 2013 or higher installing the Smart Indenter addin will fail. This article will explain how to install it so it will work regardless of the Office version installed.
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…
Finds all prime numbers in a range requested and places them in a public primes() array. I've demostrated a template size of 30 (2 * 3 * 5) but larger templates can be built such 210  (2 * 3 * 5 * 7) or 2310  (2 * 3 * 5 * 7 * 11). The larger templa…

856 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question