I have code below, works fine but notice the if statements and how it loops through two worksheets separately but ultimately does the same thing.. any ideas / advice feedback on how to make it more efficient if possible? I'm pretty new to VBA so this was the only way I new how to do this. Thanks in advance.
Code:
Sub Button4_Click()
Application.ScreenUpdating = False
Application.EnableEvents = False
Dim strFileName As String
Dim wb1 As Workbook
Dim ws1 As Worksheet
Dim ws1A As Worksheet
Dim wb2 As Workbook
Dim ws2 As Worksheet
Dim ws3 As Worksheet
Dim cell As Range
Dim rng As Range
Dim rng2 As Range
Dim RangeName As String
Dim CellName As String
Dim dstRng As Range
Dim NewFile As Variant
Dim strpath As String
Dim strfoldername As String
Dim strfullpath As String
Do
DoEvents
'prompt folder location
NewFile = Application.GetOpenFilename("Microsoft Excel files (*.xlsm*), *.xlsm*")
If NewFile = False Then Exit Sub 'User canceled (apply error handeling if user does not select a file)
Set wb1 = Workbooks.Open(NewFile)
If Not Evaluate("ISREF('RVP Local GAAP'!A1)") Or _
Not Evaluate("ISREF('RVP Group GAAP'!A1)") Then 'Test if worksheet names exist
MsgBox "Please Select the correct file.", vbExclamation, "Invalid File Selected."
wb1.Close SaveChanges:=False
Else: Exit Do
End If
Loop
'declare variables
Set wb2 = ThisWorkbook
Set ws2 = wb2.Sheets("Output - Flat")
Set ws1 = wb1.Sheets("RVP Local GAAP")
Set rng = Range("CurrentTaxPerLocalGAAPProvision")
Set rng2 = Range("CurrentTaxPerGroupGAAPProvision")
Set ws1A = wb1.Sheets("RVP Group GAAP")
Set ws3 = wb1.Sheets("Index")
''add corptax entity name in "entity name" field in worksheet index of template
''on index sheet D4 named range is "EntityName"
ws2.Range("CorpTaxEntityName").Copy
ws3.Range("D4").PasteSpecial xlPasteValues
Application.CutCopyMode = False
'Loop through all the values in NamedRange
For Each rng In ws2.Range("NamedRange")
Set dstRng = Nothing
On Error Resume Next
Set dstRng = ws1.Range(rng.Value)
On Error GoTo 0
'Check that the range exists in destination sheet
If Not dstRng Is Nothing Then
'Check that the range exists in the appropriate area
If Not Intersect(dstRng, ws1.Range("CurrentTaxPerLocalGAAPProvision")) Is Nothing Then
'Transfer the value from the next column to the appropriate range in the
'destination sheet
dstRng.Value = rng.Offset(0, 1).Value
''ElseIf rng.Value <> dstRng Then
''MsgBox rng.Value & " not in RVP Local GAAP sheet"
Else
End If
End If
Next
For Each rng2 In ws2.Range("NamedRange")
Set dstRng = Nothing
On Error Resume Next
Set dstRng = ws1A.Range(rng2.Value)
On Error GoTo 0
'Check that the range exists in destination sheet
If Not dstRng Is Nothing Then
'Check that the range exists in the appropriate area
If Not Intersect(dstRng, ws1A.Range("CurrentTaxPerGroupGAAPProvision")) Is Nothing Then
''MsgBox "succesful"
''found = False
'Transfer the value from the next column to the appropriate range in the
'destination sheet
dstRng.Value = rng2.Offset(0, 1).Value
ElseIf rng2.Value <> dstRng Then
MsgBox rng2.Value & " not in RVP Group GAAP sheet"
End If
End If
Next
''MsgBox "Values have copied over sucessfully"
''create folder
strpath = "C:\Users" & Environ("UserName") & "\Desktop"
strfoldername = "Templates"
strfullpath = strpath & strfoldername & ""
If Dir(strpath & strfoldername, vbDirectory) = "" Then
MkDir strfullpath
End If
''save and close workbook to folder
wb1.SaveAs fileName:=strfullpath & "wb1.xlsm"
wb1.Close
End Sub
Last edited by a moderator: