Need a VBA GURU!!! - Macro help copying and pasting data

[Johnny Thunder]

Hello All,


I am in search of a greater being who possesses the power to help me with my macro.

I will tell you what it needs to do and what I have come up with so far.

1.Based on Sheet "Main" Cell "B23" which is a drop down list of File names that correspond to Company names.

2.Based on Sheet "Main" Cell "B19" which is a drop down list of tab names that correspond to standerized tab names of multiple files from the drop down list above in cell "B23".

3. If Sheets "Main" Cell "B19" = "ODM" then go to sheet "Agreement" and copy range ("B14:H" & Lastrow) Last row being the last row of data in column H.

4. Open Workbook which is defined from Sheets "main" Cell "B23" and Goto Specific tab which is defined in original workbook Sheets "Main" Cell "B19".

5. If Sheets "Main" Cell "B19" = "ODM" then in NewWorkBook PasteValues in Range ("C14:I" & Lastrow) *I think thats how it should be written?

6.then I need it to ElseIF the New Workbook isn't a .XLSM then redo all the same steps but look for .XLS instead.

7. And I will have a few other #3 that will be different names other than "ODM" which correspond to different ranges.

**I hope I was very descriptive in what I am trying to accomplish. I know some of what I am trying to do isn't in my current macro but it's what the end result should be.

Hopefully someone might be able to simplify my macro or at least point me in the right direction to work with this.

Thanks in advance!!

My Code-

Sub OpenWorkbook()

Dim LastRow As Long
Dim w As Workbook
'Defines file name
varCellvalue = Sheets("Main").Range("B23").Value

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


Set w = ActiveWorkbook
LastRow = Cells(Rows.Count, "B").End(xlUp).Row

w.Activate

If Sheets("main").Range("B19") = "ODM" Then
Sheets("Agreement").Activate
Range("B14:H" & LastRow).Select
Selection.Copy

ElseIf Sheets("main").Range("B19") = "MPA" Then
Sheets("Agreement").Activate
Range("B14:K" & LastRow).Select
Selection.Copy

ElseIf Sheets("main").Range("B19") = "ODM" Then
Sheets("Agreement").Activate
Range("B14:H" & LastRow).Select
Selection.Copy

Else

End If

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

Range("C14:H" & LastRow).Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Application.CutCopyMode = False


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]

Bump

 

[James Snyder]

Assuming you are able to do the copying and pasting adequately, this part of your code could be replaced with a 'Case' statement:

If Sheets("main").Range("B19") = "ODM" Then
                  Sheets("Agreement").Activate
                  Range("B14:H" & LastRow).Select
                    Selection.Copy
    
       ElseIf Sheets("main").Range("B19") = "MPA" Then
       Sheets("Agreement").Activate
       Range("B14:K" & LastRow).Select
       Selection.Copy
           
                ElseIf Sheets("main").Range("B19") = "ODM" Then
                Sheets("Agreement").Activate
                Range("B14:H" & LastRow).Select
                Selection.Copy

Here is a stab at the syntax, etc. (untested):

Select Case Sheets("main").Range("B19")
    Case "ODM"
        ' code here for copy, etc.
        Range("B14:H" & LastRow).Copy
        
    Case "MPA"
        ' code here for copy, etc.
        Range("B14:H" & LastRow).Copy
        
    Case "XYZ"
        ' code here for copy, etc.
        Range("B14:H" & LastRow).Copy
        
    Case Else
        ' any error handling for a new company
End Select

I have yet to work with dropdowns in cells, so I will defer to the greater gods of Excel...

 

[Johnny Thunder]

This is definitely a start so I appreciate the help!

 

[Johnny Thunder]

Worked Perfectly now I just need some modification to the code, here is what I have so far.

In the lower portion of the code I have a remark that says "Code needed here************

What I need this part of the code to say is -reference your original workbook and IF Sheets("Main").Range("B19").Value ="ODM" Paste starting in Range("C14"), if IF="MPA" paste starting in Range("H14"). I am assuming I can use the CASE statement to write the different arguments but how do I tell the code to look back at the original workbook but paste to the new workbook that I just opened?

Thanks again!


Sub OpenWorkbook()

Dim LastRow As Long
Dim w As Workbook
'Defines file name
varCellvalue = Sheets("Main").Range("B23").Value

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


Set w = ActiveWorkbook
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
w.Activate

Select Case Sheets("main").Range("B19")

Case "ODM"
Sheets("Agreement").Activate
Range("B14:H" & LastRow).Select
Range(Selection, Selection.End(xlDown)).Select
Range("B14:H" & LastRow).Copy
Selection.Copy

Case "MPA"
Sheets("Agreement").Activate
Range("B14:K" & LastRow).Select
Range(Selection, Selection.End(xlDown)).Select
Range("B14:K" & LastRow).Copy
Selection.Copy

Case "ODM"
Sheets("Agreement").Activate
Range("B14:H" & LastRow).Select
Range(Selection, Selection.End(xlDown)).Select
Range("B14:H" & LastRow).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

'Code needed Here***********************

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

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]

Got a little further,
Now I just need to recode the section that opens the file, with "Workbooks.Open "\\Lax-Netapp01\Dept_private\Business Systems\LFC MACRO TEST\" & varCellvalue & ".xlsm" OR "XLS" But I am not sure how to write that? Any ideas?

Code:
Sub OpenWorkbook()

Dim LastRow As Long
Dim w As Workbook
'Defines file name
varCellvalue = Sheets("Main").Range("B23").Value

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


Set w = ActiveWorkbook
LastRow = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
w.Activate

Select Case Sheets("main").Range("B19")

Case "PLA"
Sheets("Agreement").Activate
Range("B14:H" & LastRow).Select
Range(Selection, Selection.End(xlDown)).Select
Range("B14:H" & LastRow).Copy
Selection.Copy

Case "MPA"
Sheets("Agreement").Activate
Range("B14:K" & LastRow).Select
Range(Selection, Selection.End(xlDown)).Select
Range("B14:K" & LastRow).Copy
Selection.Copy

Case "ODM"
Sheets("Agreement").Activate
Range("B14:H" & LastRow).Select
Range(Selection, Selection.End(xlDown)).Select
Range("B14:H" & LastRow).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

 

[James Snyder]

Sorry for the delay, but was doing something. Easiest way I can think of is to set a variable to either ".XLSX", "XLSM" or ".XLS" and add that to the path string. I assume that you know that before trying to open and can add it:

Dim path As String
Dim file As String
Dim extension As String

path = "[COLOR=#333333]\\Lax-Netapp01\Dept_private\Business Systems\LFC MACRO TEST"
[/COLOR]file = [COLOR=#333333]varCellvalue 
[/COLOR]extension = otherVarCellValue

[COLOR=#333333]Workbooks.Open [/COLOR]path & "\" & file & "." & extension

 

[Johnny Thunder]

So do I need to add this in or will this only work if I know what the extension is for each file?

Sorry I am a little confused but thanks for your patience.

 

[James Snyder]

That will only work if you know the extension of the file and was just an example. You would still need to merge that with your code. If you do not know the extension, but know the file name root and the path, you can use the ""Dir" command to test for which is there. This is a function copied from working code, so you will have to adapt it to your code, but it works:

'##########################################################################
'##  FileExists
'##########################################################################
Private Function FileExists(pathStr As String, Optional Directory As Boolean) As Boolean
    ' Tests a passed path for existance and returns true/false
    If IsMissing(Directory) Or Directory = False Then
        If pathStr <> vbNullString Then
            FileExists = (Dir$(pathStr) > vbNullString)
        Else
            FileExists = False
        End If
    Else    ' Directory exists requested
        FileExists = (Dir$(pathStr, vbDirectory) > vbNullString)
    End If
End Function    ' FileExists

 

[Johnny Thunder]

I will try it.

How do you get your code into the boxes?