I've created a basic macro within a workbook to clear data from a set number of tabs then copy in refreshed data from external workbooks. There is a master data tab within the workbook that uses IF formulas to obtain various stock information for that tab which then feeds through to other sheets. EG
=IF($A$2="","",SUMIF(Data_CoventryStock!$A:$A,Data!$A$2,Data_CoventryStock!$E:$E))
Currently when the macro runs it produces the desired result but the IF Formulas lose the reference to the range eg $A:$A
becomes #N/A!
I've been looking online for a solution but am unable to see a suitable option. I am new to this area.
Sub Update()
'
' Update Macro
'
Application.DisplayAlerts = False
' Clears data from tabs
Sheets("Data_10Day").Select
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Sheets("Data_CoventryStock").Select
Columns("A:E").Select
Selection.Delete Shift:=xlToLeft
Sheets("Data_CowleyStock").Select
Columns("A:E").Select
Selection.Delete Shift:=xlToLeft
Sheets("Data_RugbyStock").Select
Columns("A:B").Select
Selection.Delete Shift:=xlToLeft
Sheets("Data_10Day").Select
' Copies data from other workbooks then pastes
Workbooks.Open Filename:= _
"C:\Users\ceasdown\Documents\HDS\Data\Data_10Day.xlsx"
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("Coventry Ordering Template2.xlsm").Activate
Sheets("Data_10Day").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("Data_10Day.xlsx").Close
Workbooks.Open Filename:= _
"C:\Users\ceasdown\Documents\HDS\Data\Data_CoventryStock.xlsx"
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("Coventry Ordering Template2.xlsm").Activate
Sheets("Data_CoventryStock").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("Data_CoventryStock.xlsx").Close
Workbooks.Open Filename:= _
"C:\Users\ceasdown\Documents\HDS\Data\Data_CowleyStock.xlsx"
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("Coventry Ordering Template2.xlsm").Activate
Sheets("Data_CowleyStock").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("Data_CowleyStock.xlsx").Close
Workbooks.Open Filename:= _
"C:\Users\ceasdown\Documents\HDS\Data\Data_RugbyStock.xlsx"
Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.Copy
Windows("Coventry Ordering Template2.xlsm").Activate
Sheets("Data_RugbyStock").Select
Range("A1").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Workbooks("Data_RugbyStock.xlsx").Close
Application.DisplayAlerts = True
End Sub
I need it to retain the cell range in the IF formula so no manual update after running the macro is required.
I try to create a code avoiding .Select
, .Activate
and repetition. The code is untested but it will give you an idea about the concept. For any question please ask me.
Option Explicit
Sub Update()
Dim ws As Worksheet
'
' Update Macro
'
Application.DisplayAlerts = False
' Clears data from tabs
For Each ws In ThisWorkbook
With ws
If .Name = "Data_10Day" Or .Name = "Data_RugbyStock" Then
.Columns("A:B").Delete Shift:=xlToLeft
ElseIf .Name = "Data_CoventryStock" Or .Name = "Data_CowleyStock" Then
.Columns("A:E").Delete Shift:=xlToLeft
End If
End With
Next ws
' Copies data from other workbooks then pastes
Call Procedure("Data_10Day.xlsx", "Data_10Day")
Call Procedure("Data_CoventryStock.xlsx", "Data_CoventryStock")
Call Procedure("Data_CowleyStock.xlsx", "Data_CowleyStock")
Call Procedure("Data_RugbyStock.xlsx", "Data_RugbyStock.xlsx")
Application.DisplayAlerts = True
End Sub
Sub Procedure(ByVal FileName As String, ByVal SheetName As String)
Workbooks.Open FileName:="C:\Users\ceasdown\Documents\HDS\Data\" & FileName
Workbooks(FileName).Sheets("Sheet1").UsedRange.Copy
Workbooks("Coventry Ordering Template2.xlsm").Sheets(SheetName).Range("A1").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Workbooks(FileName).Close
End Sub
The reason your formulas get damaged is that you are Deleting the ranges they refer to. Instead of deleting, use ClearContents
instead.
Also, your code can do with quite a bit of optimsation.
Consider this
Sub Update()
Dim wbMain As Workbook
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Dim FilePath As String
Application.DisplayAlerts = False
Set wbMain = ActiveWorkbook
With wbMain
FilePath = Environ$("UserProfile") & "\Documents\HDS\Data\"
' Copies data from other workbooks then pastes
UpdateFromWB .Worksheets("Data_10Day").Cells(1, 1), FilePath & "Data_10Day.xlsx", "WhatSheet?"
UpdateFromWB .Worksheets("Data_CoventryStock").Cells(1, 1), FilePath & "Data_CoventryStock.xlsx", "WhatSheet?"
UpdateFromWB .Worksheets("Data_CowleyStock").Cells(1, 1), FilePath & "Data_CowleyStock.xlsx", "WhatSheet?"
UpdateFromWB .Worksheets("Data_RugbyStock").Cells(1, 1), FilePath & "Data_RugbyStock.xlsx", "WhatSheet?"
End With
Application.DisplayAlerts = True
End Sub
Private Sub UpdateFromWB(rngDest As Range, wbName As String, wsName As String)
Dim wb As Workbook
Dim ws As Worksheet
Dim rng As Range
Set wb = Workbooks.Open(Filename:=wbName)
Set ws = wb.Worksheets(wsName)
With ws
Set rng = .Range(.Cells(1, 1).End(xlDown), .Cells(1, 1).End(xlToRight))
'Alternative, in case there might be gaps in the data
'Set rng = .Range(.Cells(.Rows.Count, 1).End(xlUp), .Cells(1, .Columns.Count).End(xlToLeft))
End With
rngDest.Worksheet.Cells.ClearContents 'Delets ALL data from sheet. Adjust range if required
rngDest.Resize(rng.Rows.Count, rng.Columns.Count).Value = rng.Value
wb.Close
End Sub
The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.