Solved

Refresh specific worksheets with VBA

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

Instantly Create Instructional Tutorials

Contextual Guidance at the moment of need helps your employees adopt to new software or processes instantly. Boost knowledge retention and employee engagement step-by-step with one easy solution.

Question has a verified solution.

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

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.
Do you use a spreadsheet like Microsoft's Excel?  Have you ever wanted to link out to a non excel file on your computer or network drive?  This is the way I found to do it!
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

730 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