Solved

Refresh specific worksheets with VBA

Posted on 2014-10-22
4
449 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 49

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

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

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

Improved? Move/Copy Add-in Replacement - How to avoid the annoying, “A formula or sheet you want to move or copy contains the name XXX, which already exists on the destination worksheet.” David Miller (dlmille)  It was one of those days… I wa…
This code takes an Excel list of URL’s and adds a header titled “URL List”. It then searches through all URL’s in column “A”, looking for duplicates. When a duplicate is found, it is moved to the top of the list. The duplicate URL’s are then highlig…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.

821 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