?
Solved

Refresh specific worksheets with VBA

Posted on 2014-10-22
4
Medium Priority
?
1,007 Views
Last Modified: 2014-10-22
Hi,

I was able to figure out how to refresh a single worksheet, but I would like to be able to loop through all sheets that are not Summary, Template or CostMemo Template and refresh the data in the vba below.  Not sure how to write the loop statement and I think the case statement to exclude worksheets is off as well.

Sub Workbook_Open()

   'Refresh project and budget information
    Dim i As Integer, x As Integer
    Dim shtname As String, strPath As String, strFilename As String, strLookupSheet As String, strLookupRange As String, strLookupValue As String
   
    Dim wbOutput As Workbook, wbLookup As Workbook
    Dim wsNew As Worksheet
    
    Set wbOutput = ActiveWorkbook
   

        ActiveSheet.Unprotect

        
        Set wsNew = ActiveSheet
     

        strPath = "\\SSFilePrint\GROUPSHARE\Store Planning\Projects\Reports\"

        strFilename = "Budget Info.xlsm"
        strLookupSheet = "Cost Tracker Budget Info"
        strLookupRange = "$A:$U"
        
                
        strLookupCell = "B7"
    
    
        Application.ScreenUpdating = False
        Workbooks.Open strPath & strFilename
        Application.AskToUpdateLinks = False
        UpdateLinks = 3
        
        
        
        For Each ws In ActiveWorkbook.Worksheets
        Select Case UCase(ws.Name)
        Case "TEMPLATE", "DROPDOWN", "SUMMARY", "COSTMEMO TEMPLATE"    'Ignore these worksheets (list in all caps!)
        Case Else
        
        Dim fmla As String
        
        '=VLOOKUP(B7,'G:\Store Planning\Projects\Reports\[Budget Info.xlsx]Cost Tracker Budget Info'!$A$1:$u$250, 4, FALSE)
            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 2, False),"""")"
            wsNew.Range("B4").Formula = fmla
            
            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 4, False),"""")"
            wsNew.Range("B5").Formula = fmla
            
            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 5, False),"""")"
            wsNew.Range("B6").Formula = fmla
            
            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 6, False),"""")"
            wsNew.Range("B8").Formula = fmla
            
            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 7, False),"""")"
            wsNew.Range("B9").Formula = fmla
            
            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 8, False),"""")"
            wsNew.Range("B10").Formula = fmla
            
            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 9, False),"""")"
            wsNew.Range("E10").Formula = fmla
            
            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 10, False),"""")"
            wsNew.Range("I4").Formula = fmla
            
            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 11, False),"""")"
            wsNew.Range("I5").Formula = fmla

            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 12, False),"""")"
            wsNew.Range("I6").Formula = fmla
            
            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 13, False),"""")"
            wsNew.Range("I7").Formula = fmla

            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 14, False),"""")"
            wsNew.Range("I8").Formula = fmla

            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 15, False),"""")"
            wsNew.Range("L5").Formula = fmla

            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 16, False),"""")"
            wsNew.Range("B13").Formula = fmla

            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 17, False),0)"
            wsNew.Range("B14").Formula = fmla

            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 18, False),0)"
            wsNew.Range("B15").Formula = fmla

            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 19, False),0)"
            wsNew.Range("B16").Formula = fmla

            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 20, False),0)"
            wsNew.Range("B17").Formula = fmla

            fmla = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ", 21, False),0)"
            wsNew.Range("B18").Formula = fmla

            wsNew.Range("B4").Value = wsNew.Range("B4").Value 'Brand
            wsNew.Range("B5").Value = wsNew.Range("B5").Value 'PM
            wsNew.Range("B6").Value = wsNew.Range("B6").Value 'Store Name
            wsNew.Range("B8").Value = wsNew.Range("B8").Value 'PCR
            wsNew.Range("B9").Value = wsNew.Range("B9").Value 'Country
            wsNew.Range("B10").Value = wsNew.Range("B10").Value 'Sales
            wsNew.Range("E10").Value = wsNew.Range("E10").Value 'Seanon
            wsNew.Range("I4").Value = wsNew.Range("I4").Value 'Design Type
        wsNew.Range("I5").Value = wsNew.Range("I5").Value 'Scope Type
            wsNew.Range("I6").Value = wsNew.Range("I6").Value 'Gross SQ
            wsNew.Range("I7").Value = wsNew.Range("I7").Value ' Selling SF
            wsNew.Range("I8").Value = wsNew.Range("I8").Value ' Frontage
            wsNew.Range("L5").Value = wsNew.Range("L5").Value ' Open Date
            wsNew.Range("B13").Value = wsNew.Range("B13").Value 'Professional Fees
            wsNew.Range("B14").Value = wsNew.Range("B14").Value 'Parts
            wsNew.Range("B15").Value = wsNew.Range("B15").Value 'Freight & Taxes
            wsNew.Range("B16").Value = wsNew.Range("B16").Value 'Contract
            wsNew.Range("B17").Value = wsNew.Range("B17").Value 'Other Cost
            wsNew.Range("B18").Value = wsNew.Range("B18").Value 'Contingency
        
        Workbooks(strFilename).Close savechanges:=False
        Application.ScreenUpdating = True
        ActiveSheet.Protect
    Next
   ' End If
End Sub

Open in new window

PPTT-2014.10.20-q3.xlsm
0
Comment
Question by:jmac001
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 2
4 Comments
 
LVL 52

Expert Comment

by:Rgonzo1971
ID: 40396869
Hi,

pls try

For Each ws In ActiveWorkbook.Worksheets
        Select Case UCase(ws.Name)
        Case "TEMPLATE", "SUMMARY", "COSTMEMO TEMPLATE"  
        Case Else
            ws.Calculate
        End Select
Next

Regards
0
 
LVL 70

Expert Comment

by:Qlemo
ID: 40396901
Several issues with the code:
* There is no END SELECT
* The NEXT needs to be positioned above closing the workbook
* You are setting several cells to their own value - what for? If you want to replace the formula by its value, replace the .Formula property.
* There is no reason to use fmla, just assign the string expression directly, or use vars for the non-changing part.
* Application.AskToUpdateLinks = False should be set before opening a workbook
0
 
LVL 70

Accepted Solution

by:
Qlemo earned 2000 total points
ID: 40396957
And that are my corrections and improvements:
Sub Workbook_Open()

   'Refresh project and budget information
    Dim i As Integer, x As Integer
    Dim shtname As String, strPath As String, strFilename As String, strLookupSheet As String, strLookupRange As String, strLookupValue As String
   
    Dim wbOutput As Workbook, wbLookup As Workbook
    Dim wsNew As Worksheet
    
    strPath = "\\SSFilePrint\GROUPSHARE\Store Planning\Projects\Reports\"
    strFilename = "Budget Info.xlsm"
    strLookupSheet = "Cost Tracker Budget Info"
    strLookupRange = "$A:$U"
    strLookupCell = "B7"
    
    Set wbOutput = ActiveWorkbook
    Set wsNew = ActiveSheet
        
    ActiveSheet.Unprotect
    Application.ScreenUpdating = False
    Application.AskToUpdateLinks = False
    UpdateLinks = 3
    Workbooks.Open strPath & strFilename
        
    Dim fmlaBegn As String, fmlaEStr As String, fmlaEInt As String
    fmlaBegn = "=IFERROR(VLOOKUP(" & strLookupCell & ",'" & strPath & "[" & strFilename & "]" & strLookupSheet & "'!" & strLookupRange & ","
    fmlaEStr = ", False),"""")"
    fmlaEInt = ", False),0)"
        
    For Each ws In ActiveWorkbook.Worksheets
        Select Case UCase(ws.Name)
            Case "TEMPLATE", "DROPDOWN", "SUMMARY", "COSTMEMO TEMPLATE"    'Ignore these worksheets (list in all caps!)
            Case Else
                wsNew.Range("B04").Formula = fmlaBegn & 2 & fmlaEStr:  wsNew.Range("B04").Formula = wsNew.Range("B04").Value 'Brand
                wsNew.Range("B05").Formula = fmlaBegn & 4 & fmlaEStr:  wsNew.Range("B05").Formula = wsNew.Range("B05").Value 'PM
                wsNew.Range("B06").Formula = fmlaBegn & 5 & fmlaEStr:  wsNew.Range("B06").Formula = wsNew.Range("B06").Value 'Store Name
                wsNew.Range("B08").Formula = fmlaBegn & 6 & fmlaEStr:  wsNew.Range("B08").Formula = wsNew.Range("B08").Value 'PCR
                wsNew.Range("B09").Formula = fmlaBegn & 7 & fmlaEStr:  wsNew.Range("B09").Formula = wsNew.Range("B09").Value 'Country
                wsNew.Range("B10").Formula = fmlaBegn & 8 & fmlaEStr:  wsNew.Range("B10").Formula = wsNew.Range("B10").Value 'Sales
                wsNew.Range("E10").Formula = fmlaBegn & 9 & fmlaEStr:  wsNew.Range("E10").Formula = wsNew.Range("E10").Value 'Seanon
                wsNew.Range("I04").Formula = fmlaBegn & 10 & fmlaEStr: wsNew.Range("I04").Formula = wsNew.Range("I04").Value 'Design Type
                wsNew.Range("I05").Formula = fmlaBegn & 11 & fmlaEStr: wsNew.Range("I05").Formula = wsNew.Range("I05").Value 'Scope Type
                wsNew.Range("I06").Formula = fmlaBegn & 12 & fmlaEStr: wsNew.Range("I06").Formula = wsNew.Range("I06").Value 'Gross SQ
                wsNew.Range("I07").Formula = fmlaBegn & 13 & fmlaEStr: wsNew.Range("I07").Formula = wsNew.Range("I07").Value 'Selling SF
                wsNew.Range("I08").Formula = fmlaBegn & 14 & fmlaEStr: wsNew.Range("I08").Formula = wsNew.Range("I08").Value 'Frontage
                wsNew.Range("L05").Formula = fmlaBegn & 15 & fmlaEStr: wsNew.Range("L05").Formula = wsNew.Range("L05").Value 'Open Date
                wsNew.Range("B13").Formula = fmlaBegn & 16 & fmlaEStr: wsNew.Range("B13").Formula = wsNew.Range("B13").Value 'Professional Fees
                
                wsNew.Range("B14").Formula = fmlaBegn & 17 & fmlaEInt: wsNew.Range("B14").Formula = wsNew.Range("B14").Value 'Parts
                wsNew.Range("B15").Formula = fmlaBegn & 18 & fmlaEInt: wsNew.Range("B15").Formula = wsNew.Range("B15").Value 'Freight & Taxes
                wsNew.Range("B16").Formula = fmlaBegn & 19 & fmlaEInt: wsNew.Range("B16").Formula = wsNew.Range("B16").Value 'Contract
                wsNew.Range("B17").Formula = fmlaBegn & 20 & fmlaEInt: wsNew.Range("B17").Formula = wsNew.Range("B17").Value 'Other Cost
                wsNew.Range("B18").Formula = fmlaBegn & 21 & fmlaEInt: wsNew.Range("B18").Formula = wsNew.Range("B18").Value 'Contingency
       End Select
    Next
    Workbooks(strFilename).Close savechanges:=False
    Application.ScreenUpdating = True
    ActiveSheet.Protect
End Sub

Open in new window

0
 

Author Closing Comment

by:jmac001
ID: 40397189
Qlemo,

Thank you very much for explaining the items that I missed and for updating some of my existing VBA to make it more efficient.   This definitely helped in being able to refresh the project and budget information if it is not available at the time that the worksheet is created by the end user.
0

Featured Post

Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Introduction This Article briefly covers methods of calculating the NPV and IRR variants in Excel as well as the limitations in calculating and interpreting IRR results. Paraphrasing Richard Shockley, author of my favourite finance reference tex…
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
This Micro Tutorial will demonstrate in Microsoft Excel how to add style and sexy appeal to horizontal bar charts.
This Micro Tutorial demonstrates in Microsoft Excel how to consolidate your marketing data by creating an interactive charts using form controls. This creates cool drop-downs for viewers of your chart to choose from.

771 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question