Solved

Refresh specific worksheets with VBA

Posted on 2014-10-22
4
515 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 50

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 69

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 69

Accepted Solution

by:
Qlemo earned 500 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

Free Tool: ZipGrep

ZipGrep is a utility that can list and search zip (.war, .ear, .jar, etc) archives for text patterns, without the need to extract the archive's contents.

One of a set of tools we're offering as a way to say thank you for being a part of the community.

Question has a verified solution.

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

This article will guide you to convert a grid from a picture into Excel format using Microsoft OneNote and no other 3rd party application.
Freeze panes is an option within all variants of Excel to enable parts of a sheet to remain stationary when the cursor is in another part of the sheet. This is a very useful feature which is overlooked or under used.
This Micro Tutorial will demonstrate how to use a scrolling table in Microsoft Excel using the INDEX function.
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…

829 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