Cell string for multiple directoires /search multiple directoires

[thebute]

Hi Everyone


Im new to VBA and have tried puting together a code from different places.
In the current code one search is being executed from the directory mentioned in cell C3
what I'm looking for is a second directory from an other cell - C4

So the code would include a search in two directories. one mentioned in cell C3 and the other in cell C4

Hope this helps

Thanks in advance for all help


here is the code:

Sub DossierNummer()

ScreenUpdating = False

RimorMacro = ActiveWorkbook.Name
    Sheets("OverzichtInhoud").Select
        Range("A2:Q2" & ActiveSheet.UsedRange.Rows.Count).ClearContents
            Range("A2").Select

Sheets("StartPunt").Select
    lrow = Range("E1", Selection.End(xlDown)).Count 'Dit is bedoeld om de namen van alle gekopieerde docs aan te geven, beginnend bij Cell E1 in Werkblad StartPunt
    fpath = Workbooks("" & RimorMacro & "").Sheets("StartPunt").Range("C3").Value 'fpath is geeft de locatie aan waar gezocht wordt naar alle te kopieren bestanden


    get_filename
For i = 2 To lrow
    If Range("E" & i).Value = "" Then 'startend vanaf E1 begint Excel vanaf de tweede cell beneden met het invullen van de namen van alle te kopieren bestanden. Waar Excel op een gegveen moment geen bestanden meer heeft en dus een lege cell heeft, stopt de Macro en wordt er een bericht gegenereerd.
        MsgBox "Gegevens staan nu klaar in de OverzichtInhoud!", vbInformation, "Status Kopiëren"
Exit Sub

Else

Fname = Workbooks("" & RimorMacro & "").Sheets("StartPunt").Cells(i, 5).Value 'Alle bestanden die Excel mbv de macro hierboven heeft gevonden en in Column E heeft geplaatst gaat hij nu 1voor1 af.
    Workbooks.Open Filename:=fpath & "\" & Fname

        mysht = ActiveWorkbook.Name
        Sheets("Worksheet").Select '...Voor elk wb die excel vind selecteert hij ws "Worksheet"
            Range("B4:B10,B29,B20,B24,B30,B31,B32,B33,B34,B35,B36").Select '...gaat hij een aantal taken uitvoeren. hier bijvoorbeeld, gaat hij een rage cellen selecteren
                Selection.Copy 'hier heeft hij aan de ranges te kopieren

Workbooks("" & RimorMacro & "").Activate '...vervolgens gaat hij, nadat hij de Worksheets heeft gekopieerd, terug naar de RapportageTool
    Sheets("OverzichtInhoud").Select 'Terug in de RapportageTool kiest excel het juiste werkblad
        Selection.PasteSpecial Paste:=xlPasteValues, Transpose:=True 'Nu plakt excel de data in rijvorm in plaaats van onder elkaar

'ActivecellOffset>eerste deel is bedoeld om aan te geven hoeveel regels er tussen de waarden moet komen
'In dit geval 0 geeft aan direct op de volgende regel eronder
'De tweede 0 geeft aan dat de waarde direct in de eerste colum moet worden geplaatst

ActiveCell.Offset(0, 0).Select
    Workbooks("" & mysht & "").Activate
        Range("B24").Select

ActiveCell.Offset(0, 0).Select
    Workbooks("" & mysht & "").Activate
        Range("B24").Select

Selection.End(xlDown).Select
Selection.Copy
Workbooks("" & RimorMacro & "").Activate
Selection.PasteSpecial Paste:=xlPasteValues
ActiveCell.Offset(1, 0).Select
Application.CutCopyMode = False
Sheets("StartPunt").Select
Workbooks("" & mysht & "").Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close
Workbooks("" & RimorMacro & "").Activate
End If
Next
End Sub
Sub get_filename()
Dim fdr As String
mrow = 2
RimorMacro = ActiveWorkbook.Name
spath = Range("C3").Value
Range("E2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.ClearContents
Range("E2").Select
fdr = Dir(spath & "\*Worksheet*.xlsm")
Do While fdr <> ""
Cells(mrow, 5).Value = fdr
fdr = Dir
mrow = mrow + 1
Loop
End Sub

 

[thebute]

iliace

Unbelievable!!!
trully Unbelievable!!!
it works. IT WORKS!!!

thanks a million iliace

I wish i had the VBA skills you have.
do you have any tips (books/websites, etc) for someone who is at the beginning line of learning VBA?
much much appriciated!!


thebute

 

[iliace]

I usually recommend learning about programming in general, starting with procedural and moving on to object-oriented programming. Understanding the Excel (and Office) object model is crucial for good VBA coding.

I like Bill Jelen's VBA and Macros, however I have heard feedback from some people that it is a little difficult for a beginner.

Another good one is Excel 2007 VBA Programmer's Reference (John Green, Rob Bovey, et al). Although it has "reference" in the title, and does contain a large reference section, the first half of the book is a no-nonsense explanation of most of the basic types of coding as well as best practices. It's a good primer, and will teach you everything you need to know, including the more serious stuff.

Excel 2010 Power Programming with VBA by John Walkenbach is another popular one, and I think also well-suited for a beginner. I've only briefly seen the 2010 edition (read 2007 extensively), but it looks like a good update for the latest versions of Excel.

Best of luck.

 

[thebute]

Hi iliace,

I was looking at you code and was wondering what the following is meant?:

[COLOR=#ff0000][B]Const iIncr As Long = 50[/B][/COLOR]

I hop that as i begin to learn mor and more and increase on my VBA skills these codes will make scence to me but for now im already greatful for your help

thebute

 

[iliace]

This is an arbitrary value that is used to increment the array size as it grows. Because the size of the array is undetermined when the procedure first runs, you have to give it a certain size. When that size is exceeded, you have to increment it. In terms of computer resources, it is not practical to grow it by 1 every time it increases in size. So iIncr is used to determine how often you increase the array size.

Initially, we give it size 50. Once it goes beyond 50 (i.e. 51) you increase the size to 100 (50+iIncr). When it gets to 100, you increase it to 150 (100+iIncr). And so on. This is the code that does it:

      If mrow > iSize Then
        iSize = iSize + iIncr
        ReDim Preserve vFiles(1 To 2, 2 To iSize)
      End If

There are three variables working in tandem here. iSize is the current array size. mrow refers to the position in the array. If mrow is greater than iSize, then iSize is increased by iIncr (which can be any positive integer), and the array is resized to meet the new requirement.

At the end of the loop, we check what the actual size was, and one last time resize the array to make it exactly the size it needs to be. This is the code:

    If iSize >= mrow Then
      iSize = mrow - 1
      ReDim Preserve vFiles(1 To 2, 2 To iSize)
    End If

We no longer need the iIncr variable, because that was just an estimate. Now that we know the exact size, we use that for our final ReDim statement.

The whole code using iSize, iIncr, and mrow (I generally call it iPos, but since you already had one I left it as is), it's basically standard code that I use to go through arrays. Depending on the application, I might change iIncr from 50 to 1000, or to 20. In your example, you only had about 25 files, so 50 seemed like a reasonable number. Start out with 50, if it gets to be more try 100 (and then 150, 200, 250); if it's less, then simply resize the array to less. In your example, it was initially 25 or so, and 50 seemed like a reasonable number, but designed to grow to any larger size in the future.

I hope this makes sense.

 

[thebute]

Goodday iliace,

thanks again for helping out on the macro.
In the code you provided, is there a way to have the macro search in all subfolders? (if there are subfolders searching in all subfolders in the two directories that will be specified in C3 & C7 on worksheet StartPunt)

thanks again iliace
TheBute