Solved

DIR issue

Posted on 2016-08-29
7
56 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

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: SSL Checker

Scans your site and returns information about your SSL implementation and certificate. Helpful for debugging and validating your SSL configuration.

One of a set of tools we are providing to everyone as a way of saying 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

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
When you see single cell contains number and text, and you have to get any date out of it seems like cracking our heads.
The viewer will learn how to use a discrete random variable to simulate the return on an investment over a period of years, create a Monte Carlo simulation using the discrete random variable, and create a graph to represent the possible returns over…
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…

749 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