Solved

Refresh specific worksheets with VBA

Posted on 2014-10-22
4
367 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
  • 2
4 Comments
 
LVL 48

Expert Comment

by:Rgonzo1971
Comment Utility
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 68

Expert Comment

by:Qlemo
Comment Utility
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 68

Accepted Solution

by:
Qlemo earned 500 total points
Comment Utility
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
Comment Utility
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

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

Drop Down List with Unique/Distinct Values (enhancing the Combo-Box with a few steps and a little code) David miller (dlmille) Intro Have you ever created a data validation list from a database field or spreadsheet column (e.g., Zip Codes or Co…
This article descibes how to create a connection between Excel and SAP and how to move data from Excel to SAP or the other way around.
The viewer will learn how to simulate a series of sales calls dependent on a single skill level and learn how to simulate a series of sales calls dependent on two skill levels. Simulating Independent Sales Calls: Enter .75 into cell C2 – “skill leve…
Excel styles will make formatting consistent and let you apply and change formatting faster. In this tutorial, you'll learn how to use Excel's built-in styles, how to modify styles, and how to create your own. You'll also learn how to use your custo…

763 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

Need Help in Real-Time?

Connect with top rated Experts

9 Experts available now in Live!

Get 1:1 Help Now