• Hi All

    Please note that at the Chandoo.org Forums there is Zero Tolerance to Spam

    Post Spam and you Will Be Deleted as a User

    Hui...

  • When starting a new post, to receive a quicker and more targeted answer, Please include a sample file in the initial post.

A Macro to get the file path from a cell then loop through it

T

Tom90

Member
I am looking for some help in VBA (Macro). What I am trying to is to open up Workbook 1/ sheet 1 in “C:\My Documents\Workstack Reports \Workbook1” , then open Workbook 1A/Drop, in “C:\My Documents \Workstack Masters\Workbook1A” and do copy and pasting between them and then close and save,
I have worked it out but a long winded way as I have inputted all the file paths but there is a problem with that is I am the only one that can rum the macro so what I was looking for is to use a reference sheet with the file path in cell “A1” for Workbook1 and cell “A2” for Workbook2 then “A3” for Workbook3 and so until it have finished and do the same for the Workbook 1A by using “B1” then “B2” for Workbook 2A and so
I guess I am looking on how to do a loop but using reference cells to get the file path
This is the Macro that i am using
Code: 
Workbooks.Open ("C:\My Documents\Workstack Reports\Workstack1.xlsx")
Application.DisplayAlerts = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1:AP5000").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Open ("C:\Users\My Documents\Workstack Reports Master\Workstack 1A.xlsx")
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
Columns("A:AT").Hidden = False
Sheets("Drop").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
Sheets("Drop").Select
Columns("A:AT").Select
Selection.Copy
Sheets("Master").Select
Range("A1").Select
 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
 
ActiveWorkbook.Close SaveChanges:=True
Windows("Workstack 1A.xlsx").Activate
ActiveWindow.Close
Workbooks.Open ("C:\My Documents\Workstack Reports\Workstack2.xlsx")
Application.DisplayAlerts = False
Selection.Copy
Sheets("Sheet1").Select
Range("A1:AP5000").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Workbooks.Open ("C:\Users\My Documents\Workstack Reports Master\Workstack 2A.xlsx")
If ActiveSheet.AutoFilterMode = True Then ActiveSheet.AutoFilterMode = False
Columns("A:AT").Hidden = False
Sheets("Drop").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
 
Sheets("Drop").Select
Columns("A:AT").Select
Selection.Copy
Sheets("Master").Select
Range("A1").Select
 
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select
 
ActiveWorkbook.Close SaveChanges:=True
Windows("Workstack 2A.xlsx").Activate
ActiveWindow.Close
Hope this makes sense the macro is no run for both of the workbooks but a separate workbook that will contain the cell that will reference the file paths along with the loop. so I am looking for is once the workbooks are open is stay open and a loop to refernce the workbook1 and 1A in each filepath and keep downing that till the workbooks are finished
Hope you will be able to see what I am looking for and be able to help
Thanks Tom


​
 
Hi,

if it's always the same with WorkstackX.xlsx and Workstack XA.xlsx,
it would be easier to only multiselect WorkstackX.xlsx files in a classic open file window
and to process each one, would'nt be ?
 
Hi Tom,

we can try somthing like the below..
Code: 
wb_mn = ActiveWorkbook.Name
drc = Range("A" & Application.Rows.Count).End(xlUp).Row
For i = 1 To drc
wb_pth = Cells(i, 1).Value
wb_pth1 = Cells(i + 1, 1).Value
Workbooks.Open (wb_pth)
wb = ActiveWorkbook.Name
Workbooks.Open (wb_pth1)
wb1 = ActiveWorkbook.Name
' mention your code here
Next i

Hope this helps....:)
 
Tom, this is my sight to select files (no separate workbook) :​
Code: 
Sub DemoFileDialog()
    With Application.FileDialog(msoFileDialogFilePicker)
        .Filters.Clear
        .Filters.Add "Workstack files", "*.xlsx"
        .AllowMultiSelect = True
        .InitialFileName = "C:\My Documents\Workstack Reports\Workstack*"
            .InitialView = msoFileDialogViewList
                  .Title = Space$(27) & "Select Workstack files to process :"
 
        If .Show Then
            Dest$ = Left$(.SelectedItems(1), InStrRev(.SelectedItems(1), _
                    Application.PathSeparator) - 1) & " Master\Workstack "
 
            If Dir(Dest & "*.xlsx") = "" Then Beep: Exit Sub
            M$ = "Files to process :"
 
            For Each FS In .SelectedItems
                FD$ = Dest & Val(Mid(FS, InStrRev(FS, "Workstack") + 9)) & "A.xlsx"
                If Dir(FD) > "" Then M = M & vbLf & vbLf & "    " & FS & vbLf & "&  " & FD
            Next
 
            MsgBox M
        End If
    End With
End Sub
So with variables FS as source file name and FD as destination file name, you can easy adapt your code …​
​
Clean it without any awful Selection, Select & Activate …​
See the Copy VBA help to copy / paste within one unique line !​
​
 
Tom, I saw in your code that only values are pasted.​
​
So it's faster & more efficient to direct assign values range to range :​
​
WorkbookDestination.WorkSheetDestination.RangeDestination.Value = WorkbookSource.WorkSheetSource.RangeSource.Value​
 
Hi Marc L and Abhi thanks for both your code I have managed to use it and work out what i had to do, Once again thanks Tom90 :)
 
Hi, Tom90!
Maybe you want to share your solution with the community, so as people who read this would have the issue or question and the solution or answer as well.
Regards!
 
Hi Guys sorry I jump the gun a wee bit for some reason it work on the test but I now cannot get it to paste special vaules on the working one, I keep getting
I keep receiving a run-time error 1004 paste special method of range class failed amd when I debug it it hightlights in yellow the code i have in purple
wb_mn = ActiveWorkbook.Name
drc = Range("A" & Application.Rows.Count).End(xlUp).Row
For i = 1 To drc
wb_pth = Cells(i, 1).Value
wb_pth1 = Cells(i + 1, 1).Value
Workbooks.Open (wb_pth)
wb = ActiveWorkbook.Name
Workbooks.Open (wb_pth1)
wb1 = ActiveWorkbook.Name

Workbooks.Open (wb_pth)
Selection.Copy
Sheets("Sheet1").Select
Range("A1:AP5000").Copy

Workbooks.Open (wb_pth1)
Sheets("Drop").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Drop").Select
Columns("A:AT").Select
Selection.Copy
Sheets("Master").Select
Range("A1").Select

Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("A1").Select

ActiveWorkbook.Close SaveChanges:=True
Windows("Workstack _BLLM51.xlsx").Activate
ActiveWindow.Close


Next i

End Sub
Hope you can help Tom90
 
Hi, Tom!
Even they're both equal in the documentation of the PasteSpecial method the argument Operation should be a member of XLPasteSpecialOperation, where it appears xlPasteSpecialOperationNone and not xlNone. Both have the value -4142 in decimal. Without having the file I'd give a try to that replacement, but I doubt it'll work fine. Otherwise consider uploading a sample file.
Regards!
 
​
Maybe Workbook or Worksheet is protected …​
​
And your six code lines to Copy / Paste can be reduced to only one !​
​
 
Is there are workbooks_open open macro in wb_pth1??
If so then the text that you have copied from wb_pth will get out of vba memory, I think..
Just check this out if it helps.

Moreover, you already have the workbooks open why are you re-opening it?
You can either activate the desired workbooks or you can copy the data and then open it..
 
Hi Abhi,

Yes your are correct and I have fixed that out but the only thing that I am lost with now is how to stop the Macro as the way that it is set up with the "Next i" at the end it gives me an error when it runs out of file path so can you help as too what code I need to input to stop it at the end of the file path.

Thanks Tom
 
Tom,

I think you can easily stop the macro by using the below code...

Code: 
sub stp_macro
Application.EnableEvents = False
 
'your code here..
 
Application.EnableEvents = True
end sub

Moreover, the files should not be going out of count..since we have provided the last value of the list using the drc variable..

Are you sure that the file names are continuous and correct??
Also can you please re-validate the file paths and names to open the correct files?
 
Hi Tom ,

I have not gone through your code in detail , but I have some doubts :

1. Does column A of your main workbook ( the one which has the code in it ) have names from A1 downwards ? Or is there a header row ?

The following statement :

drc = Range("A" & Application.Rows.Count).End(xlUp).Row

basically assigns the value of the last row to the variable drc.

Now , the next statement :

For i = 1 To drc

starts the For loop counter from 1 ; if your data starts from A2 , you need to change the start point , or reduce the endpoint , so that you have the correct number of iterations.

2. Which brings me to the following :

wb_pth = Cells(i, 1).Value
wb_pth1 = Cells(i + 1, 1).Value

The above two statements mean that on every iteration through the For loop , you are looking at opening or reading from 2 files ; so if the last row of data is 10 , you should be performing only 5 iterations , not 10.

Also , while going through the cells , you should be looking at 1,2 then 3,4 then 5,6 and so on. This should not be done using a For ... Next loop. It is better to use a Do ... Loop Until or a Do While .... Loop construct. Within the loop you can use a counter and increment it appropriately.

Narayan
 
Hi Naraya, Abhi,

You are correct in waht you say.

I have no headers so the file path is stating at A1 but I have change it a bit and are using B1 as well so I have one file path starting at A1 and the other starting at B1 as per the code below so this may be why the drc in not stopping the macro. This is my first try at loop's so as you can see so sorry if I am not explaining it to good

wb_pth = Cells(i, 1).Value
wb_pth1 = Cells(i + 1, 2).Value

So can any of you explain what I have to do to change the code and I guess it will have somthing to do with the drc = Range("A" & Application.Rows.Count).End(xlUp).Row
Thanks Tom
 
Hi Tom ,

There is still some confusion ; in the Immediate Window , type in the following :

?Cells(1,1).Address

?Cells(2,1).Address

and see what is displayed.

When you use :

wb_pth = Cells(i, 1).Value

you are using the values in column A , since the second parameter being 1 means the column is A.

When you use :

wb_pth1 = Cells(i + 1, 2).Value

you are incrementing both row and column.

This is not correct.

In each iteration of the For loop , you should be using :

wb_pth = Cells(i, 1).Value
wb_pth1 = Cells(i, 2).Value

so that wb_pth refers to the path in column A , and wb_pth1 refers to the path in column B.

Narayan
 
Hi Narayan,

I have made changes as in last post to,
wb_pth = Cells(i, 1).Value
wb_pth1 = Cells(i, 2).Value
Works grat but still not finishing it is still coming up with an error and it is looking to continue with the file path??? any idea

Tom
 
Hi Tom ,

Can you post the error message ? If it is a For ... Next loop , there is no reason for the error , since when the loop has completed the number of specified iterations , it should exit.

Also , what do the following lines do , in each iteration ?

Windows("Workstack _BLLM51.xlsx").Activate
ActiveWindow.Close

Narayan
 
Hi Narayan,

I have been looking at macro for a long time and I realised that there were some data in column "A" further down the column past my file path so the loop was looking at it thinking that it was a file path so when I deleteted everthing under my last file path it work great, a lesson learned,

Thanks to all who have helped me I have learened a lot about loops, Tom
 
Sorry Tom was out on Sunday so could not respond...
However Narayan has very rightly mentioned what must have been wrong on the loop part..:)
 
You must log in or register to reply here.
Back
Top