0

So i have the following macro, which extracts unique values from column C of a workbook with multiple sheets and pastes it to a new page. I do realize their is another question similar, but I do not understand it. Is there a way to:

1) do this amongst a directory of files?

2) put new values into a master sheet instead of just making a new sheet in each file:

 Sub extractuniquevalues()
Dim wks As Excel.Worksheet
Dim wksSummary As Excel.Worksheet
'----------------------------------------------------------------------------------

On Error Resume Next
Set wksSummary = Excel.ThisWorkbook.Worksheets("Unique data")
On Error GoTo 0

If wksSummary Is Nothing Then
    Set wksSummary = Excel.ThisWorkbook.Worksheets.Add
    wksSummary.Name = "Unique data"
End If


'Iterate through all the worksheets, but skip [Summary] worksheet.
For Each wks In Excel.ActiveWorkbook.Worksheets

    With wksSummary

        If wks.Name <> .Name Then
            If Application.WorksheetFunction.CountA(wks.Range("C:C")) Then
                Call wks.Range("C:C").AdvancedFilter(xlFilterCopy, , .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row + 1, 1), True)
            End If
        End If

    End With

Next wks

 End Sub

Any help would be Greatly Appreciated, Thanks.

Jonathan
  • 313
  • 4
  • 16
  • possible duplicate of [Combining data from multiple workbooks into a master](http://stackoverflow.com/questions/22331311/combining-data-from-multiple-workbooks-into-a-master) – puzzlepiece87 Jul 28 '15 at 21:36

1 Answers1

2

Both of your requests can be done: (See my comments)

Sub Main()
    'Turn off alerts like "Do you really want to quit?"
    Application.DisplayAlerts = False

    Call LoopThroughDirectory("D:\Private\Excel\", "*.xls*")

    'Turn alerts on
    Application.DisplayAlerts = True
End Sub

Sub LoopThroughDirectory(dirPath As String, filter As String)
    Dim filename
    'Loop throug all of the files in the given directory
    filename = Dir(dirPath & filter)
    Do While Len(filename) > 0
        ' Filename variable contains the name of the file in the directory
        ' (dirPath & Filename) will be the full path to the file

        ' Lets call here another Sub which will open up workbooks for us.
        OpenAnotherWorkbook (dirPath & filename)

        'Move on to the next file
        filename = Dir
    Loop
End Sub

Sub OpenAnotherWorkbook(filePath As String)
    'Your master workbook to copy to
    Dim master_wb As Workbook
    Set master_wb = ThisWorkbook

    'Your source workbook to copy from
    Dim source_wb As Workbook
    Set source_wb = Application.Workbooks.Open(filePath)

    'Call your subroutine
    Call YourSub(master_wb, source_wb)

    'Close source workbook after everything is done
    source_wb.Close
End Sub

Sub YourSub(master_wb As Workbook, source_wb As Workbook)
    ' Do your stuff here
    '   For example:

    'Find your master sheet
    Dim master_ws As Worksheet
    Set master_ws = GetOrCreateWorksheet(master_wb, "YourSheetName")

    Dim source_ws As Worksheet
    Set source_ws = source_wb.Sheets(1)

    'Lets save some data from the another workbook to the master one.
    Dim lastRowNo As Integer
    lastRowNo = master_ws.UsedRange.Rows.Count
    'If lastRowNo is 1 that means the worksheet is empty or only the headers had been initialized
    If lastRowNo = 1 Then
        'Create headers for the columns
        master_ws.Cells(lastRowNo, 1).Value = "Workbook"
        master_ws.Cells(lastRowNo, 2).Value = "Worksheet"
    End If
    'Give some value to the next empty row's first and second cell
    'Source workbook's name
    master_ws.Cells(lastRowNo + 1, 1).Value = source_wb.Name
    'Source worksheet's name
    master_ws.Cells(lastRowNo + 1, 2).Value = source_ws.Name 

End Sub

Function GetOrCreateWorksheet(wb As Workbook, wsName As String) As Worksheet
    Dim ws As Worksheet
    'Loop through each sheet to find yours
    For Each ws In wb.Sheets
        If ws.Name = wsName Then
            'If found return with it
            Set GetOrCreateWorksheet = ws
            Exit Function
        End If
    Next ws

    'If not exists, create one and return with it
    Set ws = wb.Sheets.Add
    ws.Name = wsName
    Set GetOrCreateWorksheet = ws
End Function
Pho3nixHun
  • 820
  • 2
  • 11
  • 24
  • @Jonathan this looks like what you want! – Michael S Priz Jul 28 '15 at 22:14
  • Thanks for much for this! So is the only thing I am changing is the directory name? I am having trouble executing this macro, sorry im a newb lol – Jonathan Jul 29 '15 at 15:30
  • Basically you can change any string in this example above, but the only must is directory in line 5. Make sure that string ends with a \ and directory exists. – Pho3nixHun Jul 29 '15 at 17:17
  • @Pho3nixHun ,thanks works! so do I run them individually or at once? if so how do I do them all at once? – Jonathan Jul 29 '15 at 17:51
  • `Sub YourSub(master_wb As Workbook, source_wb As Workbook)` is something you have to modify. There you can implement your logic to harvest data out of your workbooks. `master_wb` is the wb you will put data and `source_wb` is where you get data from. All other logic is up to you. – Pho3nixHun Jul 30 '15 at 10:50
  • @Pho3nixHun, thanks! I see, these are all individual macros that do different things. How can I combine this with my code to do the loop through directory and apply to master workbook? – Jonathan Jul 30 '15 at 13:37
  • Only the run sub is running when I click run macro, when i highlight another sub im not getting anywhere. – Jonathan Jul 30 '15 at 15:28
  • Since any other Sub needs at least one parameter, you will not be able to run them with the "►" button. I suggest you to try to understand basic programming first. (Routines, Functions, variables, parameter-passing, objects, maybe OOP ...etc). – Pho3nixHun Nov 21 '15 at 14:43