VBA file browser command to open any workbook to define as SourceWB

[Rowland Hamilton]

Folks:

I want to add this functionality to my code:
VBA file browser command to open any workbook to define as SourceWB
What is the easy way to add this functionality to the following code (Or the most efficient way to do what this code does and add this functionality to it)?:

 Sub Populate_line_item_workbooka()
  
Dim MasterWB As Workbook
Dim SourceWB As Workbook
  
Dim ws As Worksheet
  
Set MasterWB = Workbooks("Line items-Combined.xlsm")
Application.DisplayAlerts = False
'we need to let excel know the Work book then we can define it as SourceWB
Workbooks.Open FileName:=ThisWorkbook.path & "\" & "United States (de linked).xlsm", _
UpdateLinks:=0
Set SourceWB = Workbooks("United States (de linked).xlsm")
'ActiveWorkbook.Names("MyRange").Name  Like "*!*"
 
SourceWB.Activate
Application.DisplayAlerts = False
On Error GoTo ErrorCatch
For Each ws In SourceWB.Worksheets
  'MsgBox (Mid(ws.Name, 5, 10))
'Here I am not sure of like *-Line item* so  I change to be  If Mid(ws.Name, 5, 10) = "-Line item" Then
    'If Mid(ws.Name, 5, 10) = "-Line item" Then 'note: Mid formula won't work bc varying number characters for cc
   If ws.Name Like "*-Line item*" Then
        ws.Select
        Range("A3").Select
   ' the sub is only short one, so no need to splite it into 2 subs, otherwise we need to activate the  Windows("Line items-Combined.xlsm") again before redefine it as SourceWB, then we can use SourceWB
    'copy
        Range("A3").Select
        Range(Selection, Selection.End(xlDown)).Select
        Range(Selection, Selection.End(xlToRight)).Select
        Selection.Copy
  
        
    'paste
        MasterWB.Activate
        Sheets("Master-Incoming").Activate
        Range("A65000").Select
        Selection.End(xlUp).Select
        ActiveCell.Offset(1, 0).Select
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  
        SourceWB.Activate
        'Exit for...No need to be Exit for here, for each......then will loop until last object in for is performed then it will stop itself.
    End If
    
Next ws
  
  MasterWB.Activate
ErrorCatch:
    
  SourceWB.Activate
  Application.CutCopyMode = False
  Range("A1").Select
  
  MasterWB.Activate
  Range("A1").Select
  
  MsgBox ("No More Sheets To Copy") 'Err.Description
End Sub

I saw this thread but have't figured out if this is the way to go:

http://www.mrexcel.com/forum/showthread.php?t=566120&highlight=vba+file+browser+code

Thank you - Rowland

 

[Norie]

Rowland

The method used in that thread, GetOpenFileName, was what I was going to suggest.

Something like this perhaps.

Option Explicit
 
Sub Populate_line_item_workbooka()
Dim MasterWB As Workbook
Dim SourceWB As Workbook
Dim rngSrc As Range
Dim rngDst As Range
Dim ws As Worksheet
Dim varFileName As Variant
 
    Set MasterWB = Workbooks("Line items-Combined.xlsm")

    varFileName = Application.GetOpenFilename(, , "Please select source workbook:")
 
    If TypeName(varFileName) = "String" Then
 
        Set SourceWB = Workbooks.Open(Filename:=varFileName, UpdateLinks:=0)
 
        For Each ws In SourceWB.Worksheets
 
            If ws.Name Like "*Line Item*" Then
 
                'copy
                Set rngSrc = ws.Range("A3").CurrentRegion
 
                'paste
                Set rngDst = MasterWB.Sheets("Master-Incoming").Range("A" & Rows.Count).End(xlUp).Offset(1)
 
                rngSrc.Copy
 
                rngDst.PasteSpecial Paste:=xlPasteValues
 
                Application.CutCopyMode = False

            End If
 
        Next ws
 
        SourceWB.Close False
 
        MsgBox "Copied all data from source workbook"
    Else
        MsgBox "No file selected"
    End If

    Application.Goto MasterWB.Worksheets("Master-Incoming").Range("A1"), True

End Sub

 

[Rowland Hamilton]

Thank you. I'll try it.

 

[Rowland Hamilton]

Norie:

That was amazing. So elegant and easy compared to the code I was using. Simply Amazing.

How can I make it ignore hidden sheets? Apparently some hidden sheets have "line item" in their name but they should not be included in the calc. Also, I may want to switch the code around later to pull other, non-hidden sheets.


Also, is your code meant to copy everything off of the sheets? My results had all the subtotals (1st rows-no subtotal label) and header rows (2nd rows) from each sheet. I was copying ranges from cell A3 and contiguous across and down to avoid copying these. How could I do that (or I could automate filtering and deleting on the master sheet/results).

Thank you so much,

Rowland

 

[Norie]

Rowland

The part for non-hidden sheets is pretty straightforward.

           If ws.Name Like "*Line Item*" And ws.Visible = xlSheetVisible Then

The next part about 'other' sheets probably needs a bit more explanation.

What sheets would they be? How would you identify them?

Shouldn't be a problem to change the copied range, but again more information needed.

Do all the sheets have subtotals? Are the subtotals always only on the last row?

This should copy everything from A3 down and across, except the last row which presumambly has the subtotals.

Set rngCopy = ws.Range("A3:A" & ws.Range("A" & Rows.Count).End(xlUp).Row - 1)
 
Set rngCopy = rngCopy.Resize(, ws.Cells(3, Columns.Count).End(xlToLeft).Column)

Or perhaps clearer:

LastRow = ws.Range("A" & Rows.Count).End(xlUp).Row - 1
LastCol = ws.Cells(3, Columns.Count).End(xlToLeft).Column
 
Set rngCopy = ws.Range("A3:A" & LastRow)
 
Set rngCopy = rngCopy.Resize(, LastCol)

 

[Rowland Hamilton]

Norie:

Thank you. I got the same solution for hidden sheets plus this for row offset from egghead cafe:

   If ws.Name Like "*Line item*" and And ws.Visible <> xlSheetHidden Then
    'copy
    Set rngSrc = ws.Range("A3").CurrentRegion.Offset(2,0)

Again, Thank you.

I'm in the middle of modifying for my next task.

How do I use your range setting method to clear everything below row 2 (non-contiguous data) on the master sheet so it can be empty and ready for updated copy/paste values?

Thank you, Rowland

 

[Rowland Hamilton]

Norie et al:

Looking to modify your code to find the row with "Grand Total" in column B, then

Range("A2:H" & LstRow).Copy

I tried this code, it only copied 2 rows, definitely not the row with "Grand Total" found in it.

How can I fix it so I can do it with your browser method or with this simple method where we know the workbooks?

Thank youRowland:

Sub try_this()
    
'copy
        Workbooks("United States (de linked)xxxx.xlsm").Activate
            Sheets("500-Sample").Activate
    
    'Expand Column groups, Collapse Row groups
                ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=2
  
          
                'contiguous method won't work:
          'Range("A3").Select
          'Range(Selection, Selection.End(xlDown)).Select
          'Range(Selection, Selection.End(xlToRight)).Select
          
        LstRow = Application.WorksheetFunction.Match("Grand Total", ActiveSheet.Range("B:B"))
            Range("A2:H" & LstRow).Copy
'paste
        Workbooks("Incoming_Data.xlsm").Activate
          Sheets("Master-Incoming").Activate
          Range("B65000").Select
          Selection.End(xlUp).Select
          ActiveCell.Offset(1, -1).Select
          
                Selection.PasteSpecial Paste:=xlPasteValues, _
          Operation:=xlNone, SkipBlanks:=False, Transpose:=False
                Selection.PasteSpecial Paste:=xlPasteFormats, _
          Operation:=xlNone, SkipBlanks:=False, Transpose:=False
  
          Workbooks("United States (de linked)xxxx.xlsm").Activate
          
                'These two maybe not necessary bc don't save this wb:
          Application.CutCopyMode = False
          Range("B1").Select
End Sub

 

[Norie]

Rowland

Sorry I don't think I can help.

This is totally different code and you don't seem to have even tried what I suggested for the range.

 

[Rowland Hamilton]

Norie:

I did follow your code. It worked when my data was contiguous (Region 1), but I have a new report to create from data that is non-contiguous.

I finally got my find last row formula to work but I can't seem to get it to work inside my macro with other variables.
Note: My previous copy data was contiguous 1 region but now I need to copy non-contiguous copy data with the parameters in this code (B1:M & lastrow)


Also, I want to use an array for worksheets so that its easier to add and remove cost centers. (2nd priority to first problem)

Finally, if I can get this licked, I'll need a separate macro with a formula for first row, since I have another set of data that resides below a table I don't need. (3rd priority, if lastrow works firstrow should work)

Thank you - Rowland

This worked:
START CODE:

Sub testing123()
 Dim LastRow As Long
 
 With Worksheets("4050CC30001")
    LastRow = Worksheets("4050CC30001").Cells(Rows.Count, "B").End(xlUp).Row
    .Range(Cells(1, 2), Cells(LastRow, 13)).Select
 End With
 End Sub

END CODE


Now how do I get that to work within this:
START CODE:

'Completed Code – Sample CC
Option Explicit
Sub Populate_line_item_Workbook_Browser_Method()
Dim MasterWB As Workbook
Dim SourceWB As Workbook
Dim rngSrc As Range
Dim rngDst As Range
Dim ws As Worksheet
Dim varFileName As Variant
Dim I As Long
Dim myArr As Variant
Dim LastRow As Long
Set MasterWB = Workbooks("Line items-Combined16.xlsm")
    
 ''''''''''Clear MasterWB'''''''''''''''''''''''''''''''''''''''''''''''''''''
    MasterWB.Sheets("Master-Incoming").Activate
       Rows("3:3").Select
    Range("E3").Activate
    Range(Selection, ActiveCell.SpecialCells(xlLastCell)).Select
    Selection.ClearContents
    Range("a1").Activate
 '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
‘"4050CC30001", "301AA1234", "50BB9999" and "65961LL3201"
myArr = Array("4050CC30001", "301AA1234", "50BB9999", "65961LL3201")
'For I = LBound(myArr) To UBound(myArr) – Don’t know how to make array work
    
    varFileName = Application.GetOpenFilename(, , "Please select source workbook:")
    If TypeName(varFileName) = "String" Then
 
        Set SourceWB = Workbooks.Open(Filename:=varFileName, UpdateLinks:=0)
 
        For Each ws In SourceWB.Worksheets
            
            If ws.Name Like "4050CC30001" And ws.Visible <> xlSheetHidden Or _
            ws.Name Like "301AA1234" And ws.Visible <> xlSheetHidden Or _
            ws.Name Like "50BB9999" And ws.Visible <> xlSheetHidden Or _
            ws.Name Like "65961LL3201" And ws.Visible <> xlSheetHidden Then
                 
                    'Expand Column groups, Collapse Row groups – need to hide lower table
                ActiveSheet.Outline.ShowLevels RowLevels:=1, ColumnLevels:=2
                
                'copy
               ‘This works for contiguous data region, but my new data is not contiguous:
               ‘Set rngSrc = ws.Range("A3").CurrentRegion.Offset(1, 0)                        
               
      LastRow = ws.Cells(Rows.Count, "B").End(xlUp).Row
              
     ‘I can’t get this to work:                 
    Set rngSrc = ws.Range(Cells(1, 2), Cells(LastRow, 13))
                'paste
                Set rngDst = MasterWB.Sheets("Master-Incoming").Range("A" & Rows.Count).End(xlUp).Offset(1)
 
                 rngSrc.Copy
                 rngDst.PasteSpecial Paste:=xlPasteValues
                 Application.CutCopyMode = False
            End If
         Next ws
         SourceWB.Close False
 
‘On contiguous data, got error message when it ran out of new sheets so I _ 
added MsgBoxes:
        MsgBox "Copied all data from source workbook"
    Else
        MsgBox "No file selected"
    End If
    Application.Goto MasterWB.Worksheets("Master-Incoming").Range("A1"), True
End Sub

END CODE

Last Row, VBA, Array, Dim, File browser, Copy/Paste between workbooks