VBA Question: Using UNION to select multiple Ranges - Not working

[Johnny Thunder]

Hello All,

I would first like to thank the MrExcel community for all the help in previous posts and future!

I am working on code that uses the UNION function to coming ranges I have set and copy the selection, currently only the first portion of the union is firing? Any help would be much appreciated. Thanks

Code:

[/Sub OpenWorkbook()

Dim LastRow As Long
   LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
  Dim w As Workbook
  Set w = ActiveWorkbook

  Dim shtdata As Worksheet
  Set shtdata = Worksheets("Agreement")
 
Dim range1 As Range, range2 As Range, multiplerange As Range

Set range1 = shtdata.Range("B14:H" & LastRow)
Set range2 = shtdata.Range("M14:N" & LastRow)
Set multiplerange = Union(range1, range2)
 
  'Defines file name
   varCellvalue = Sheets("Main").Range("B23").Value

  'Defines Type of agreement and assigns Sheet to find
   VarCell = Sheets("Main").Range("B19").Value

  'Beginning of code
  
                w.Activate

               Select Case Sheets("main").Range("B19")
               
               Case "PLA"
                  Sheets("Agreement").Activate
                  multiplerange.Select
                     Range(Selection, Selection.End(xlDown)).Select
                       multiplerange.Copy
                         Selection.Copy
    
                Case "MPA"
                  Sheets("Agreement").Activate
                  multiplerange.Select
                     Range(Selection, Selection.End(xlDown)).Select
                       multiplerange.Copy
                         Selection.Copy
       
                 Case "ODM"
                  Sheets("Agreement").Activate
                  multiplerange.Select
                     Range(Selection, Selection.End(xlDown)).Select
                       multiplerange.Copy
                         Selection.Copy
       
                                              
        End Select
         
     Sheets("Main").Activate
     If Not IsEmpty(Range("B23").Value) Then
    
          ' Opens the workbook based on company name
            Workbooks.Open "\\Lax-Netapp01\Dept_private\Business Systems\LFC MACRO TEST\" & varCellvalue & ".xlsm"
             
                            
       'selects sheet based on agreement type from "Main" tab
        Workbooks(varCellvalue & ".xlsm").Sheets(VarCell).Activate
    
      Select Case ThisWorkbook.Sheets("Main").Range("B19")
      
                  Case "PLA"
                   Range("C14").Select
                     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                       :=False, Transpose:=False
            
                  Case "MPA"
                   Range("C14").Select
                     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                       :=False, Transpose:=False
            
                   Case "ODM"
                   Range("C14").Select
                     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                       :=False, Transpose:=False
            
    End Select
    
    Else
    
     Workbooks.Open "\\Lax-Netapp01\Dept_private\Business Systems\LFC MACRO TEST\" & varCellvalue & ".xls"

     Workbooks(varCellvalue & ".xls").Sheets(VarCell).Activate

   End If

      End Sub]

 

[Johnny Thunder]

***Revised to include code properly in BB code format.
Hello All,

I would first like to thank the MrExcel community for all the help in previous posts and future!

I am working on code that uses the UNION function to coming ranges I have set and copy the selection, currently only the first portion of the union is firing? Any help would be much appreciated. Thanks

Code:

Sub OpenWorkbook()

Dim LastRow As Long
   LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
 
  Dim w As Workbook
  Set w = ActiveWorkbook

  Dim shtdata As Worksheet
  Set shtdata = Worksheets("Agreement")
 
Dim range1 As Range, range2 As Range, multiplerange As Range

Set range1 = shtdata.Range("B14:H" & LastRow)
Set range2 = shtdata.Range("M14:N" & LastRow)
Set multiplerange = Union(range1, range2)
 
  'Defines file name
   varCellvalue = Sheets("Main").Range("B23").Value

  'Defines Type of agreement and assigns Sheet to find
   VarCell = Sheets("Main").Range("B19").Value

  'Beginning of code
  
                w.Activate

               Select Case Sheets("main").Range("B19")
               
               Case "PLA"
                  Sheets("Agreement").Activate
                  multiplerange.Select
                     Range(Selection, Selection.End(xlDown)).Select
                       multiplerange.Copy
                         Selection.Copy
    
                Case "MPA"
                  Sheets("Agreement").Activate
                  multiplerange.Select
                     Range(Selection, Selection.End(xlDown)).Select
                       multiplerange.Copy
                         Selection.Copy
       
                 Case "ODM"
                  Sheets("Agreement").Activate
                  multiplerange.Select
                     Range(Selection, Selection.End(xlDown)).Select
                       multiplerange.Copy
                         Selection.Copy
       
                                              
        End Select
         
     Sheets("Main").Activate
     If Not IsEmpty(Range("B23").Value) Then
    
          ' Opens the workbook based on company name
            Workbooks.Open "\\Lax-Netapp01\Dept_private\Business Systems\LFC MACRO TEST\" & varCellvalue & ".xlsm"
             
                            
       'selects sheet based on agreement type from "Main" tab
        Workbooks(varCellvalue & ".xlsm").Sheets(VarCell).Activate
    
      Select Case ThisWorkbook.Sheets("Main").Range("B19")
      
                  Case "PLA"
                   Range("C14").Select
                     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                       :=False, Transpose:=False
            
                  Case "MPA"
                   Range("C14").Select
                     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                       :=False, Transpose:=False
            
                   Case "ODM"
                   Range("C14").Select
                     Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
                       :=False, Transpose:=False
            
    End Select
    
    Else
    
     Workbooks.Open "\\Lax-Netapp01\Dept_private\Business Systems\LFC MACRO TEST\" & varCellvalue & ".xls"

     Workbooks(varCellvalue & ".xls").Sheets(VarCell).Activate

   End If

      End Sub

 

[drgs]

For one, in parts of your code where you use Select Case -- the code is the same for all cases. What's the purpose?

You cannot accumulate copied cells in the clip board. You should copy and paste for each time, I guess

Sheets("Agreement").Activate
multiplerange.Copy
Workbooks(varCellvalue & ".xlsm").Sheets(VarCell).Range("C14").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False



Range(multiplerange, Selection.End(xlDown)).Copy
Workbooks(varCellvalue & ".xlsm").Sheets(VarCell).Range("I14").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
?

 

[Johnny Thunder]

I will try and do some code clean-up and implement your comment. Thanks!

I still think there is some parts of this that I won't be able to figure out though.