dpaton05
Well-known Member
- Joined
- Aug 14, 2018
- Messages
- 2,352
- Office Version
- 365
- 2016
- Platform
- Windows
I have a main spreadsheet that is used to calculate amounts. It has a table that I use index match match to return the values. This table is on sheet2 and has the range A4:E12. Once the figures are calculated, they are sent to another workbook for storage. This other workbook can be called my storage workbook and has the same sheet2 with the same range for the table, A4:E12. If there is a late cancel, I need to recalculate the price again. At the moment, the prices are stored in my calculator spreadsheet and in my storage spreadsheet and instead of having 2 separate instances of the prices that I will need to keep updated, I want only 1 instance.
I was thinking that each time data is copied to one of these storage spreadsheets, I could get code to compare the range A4:E12 of sheet2 in both workbooks and if they were different, copy the range from my calculator spreadsheet to my storage spreadsheet. This would ensure that the prices are always up to date and each time I needed to update the prices, I would only have to do it for one workbook instead of at least 10 different workbooks.
I have code that correctly copies information from the calculator spreadsheet to the storage spreadsheet.
Could someone please help me with some code that will compare the 2 mentioned ranges, sheet2 in the current workbook and sheet2 in the workbook identified as wsDst and if they are different, copy the range in the workbook that holds the procedure to the workbook identified as wsDst?
I was thinking that each time data is copied to one of these storage spreadsheets, I could get code to compare the range A4:E12 of sheet2 in both workbooks and if they were different, copy the range from my calculator spreadsheet to my storage spreadsheet. This would ensure that the prices are always up to date and each time I needed to update the prices, I would only have to do it for one workbook instead of at least 10 different workbooks.
I have code that correctly copies information from the calculator spreadsheet to the storage spreadsheet.
VBA Code:
Sub cmdCopy()
'On Error GoTo ErrorMsg
Dim wsDst As Worksheet, wsHours As Worksheet, wsTrack As Worksheet, worker As String, wsSrc As Worksheet, tblrow As ListRow
Dim Combo As String, sht As Worksheet, tbl As ListObject
Dim lastrow As Long, DocYearName As String, Site As String, lr As Long, HoursRow As Long
Dim RowColor As Long, w As Window, r As Long, HoursRegister As String, ReportTracking As String
Application.ScreenUpdating = False
'assign values to variables
Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
Set sht = ThisWorkbook.Worksheets("Costing_tool")
Site = ThisWorkbook.Worksheets("Start_here").Range("H9").Value
'Check if each row has a date, service and requesting organisation
For Each tblrow In tbl.ListRows
If tblrow.Range.Cells(1, 1).Value = "" Or tblrow.Range.Cells(1, 5).Value = "" Or tblrow.Range.Cells(1, 6).Value = "" Then
MsgBox "The Date, Service or Requesting Organisation has not been entered for every record in the table"
Exit Sub
End If
Next tblrow
For Each tblrow In tbl.ListRows
'Define combo as the month to be recorded in
Combo = tblrow.Range.Cells(1, 26).Value
'If column 8 for the row is blank...
If Not tblrow.Range(1, 8).Value = "" Then
'worker variable is defined as the value in column 8 of the row
worker = tblrow.Range.Cells(1, 8).Value
Else
'otherwise, "not allocated" is assigned to the worker variable.
'this is used in the hours register to identify which sheet to place the hours in
worker = "Not allocated"
End If
'defines HoursRegister as the hours register filename that is stored in column 38 for the row
HoursRegister = tblrow.Range.Cells(1, 38)
'defines ReportTracking as the report tracking filename that is stored in column 39 for the row
ReportTracking = tblrow.Range.Cells(1, 39)
Select Case Site
Case "Wt"
Select Case tblrow.Range.Cells(1, 6).Value
Case "Wes", "Wag", "Alb", "SC", "Yir"
DocYearName = tblrow.Range.Cells(1, 37).Value
Case Else
DocYearName = tblrow.Range.Cells(1, 36).Value
End Select
Case "Riv"
Select Case tblrow.Range.Cells(1, 6).Value
Case "Wes", "Wag", "Alb", "SC", "Yir"
DocYearName = tblrow.Range.Cells(1, 42).Value
Case Else
DocYearName = tblrow.Range.Cells(1, 36).Value
End Select
End Select
If Not isFileOpen(DocYearName & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Work Allocation Sheets" & "\" & Site & "\" & DocYearName & ".xlsm"
If Not isFileOpen(HoursRegister & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Hours Register" & "\" & Site & "\" & HoursRegister & ".xlsm"
If Not isFileOpen(ReportTracking & ".xlsm") Then Workbooks.Open ThisWorkbook.Path & "\" & "Report Tracking" & "\" & Site & "\" & ReportTracking & ".xlsm"
'This is my hours register workbook
Set wsHours = Workbooks(HoursRegister).Worksheets(worker)
'This is my storage workbook
Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
'This is my report tracking workbook
Set wsTrack = Workbooks(ReportTracking).Worksheets(Combo)
lr = wsDst.Cells.Find("*", , xlValues, , xlRows, xlPrevious).Row
With wsHours
'this copies the date column in the tblCosting
HoursRow = .Range("A" & Rows.Count).End(xlUp).Row
tblrow.Range(, 1).Copy
'this pastes it into column A of hours register file
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
tblrow.Range(, 4).Copy
'this pastes it into column B of hours register file
.Range("B" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
tblrow.Range(, 3).Copy
'this pastes it into column A of hours register file
.Range("C" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the hours column in the tblCosting
tblrow.Range(, 9).Copy
'this pastes it into column A of hours register file
.Range("D" & HoursRow).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
End With
With wsTrack
'this copies the date column in the tblCosting
tblrow.Range(, 1).Copy
'this pastes it into column A of hours register file
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
tblrow.Range(, 4).Copy
'this pastes it into column B of hours register file
.Range("A" & Rows.Count).End(xlUp).Offset(, 1).PasteSpecial xlPasteFormulasAndNumberFormats
'this copies the YP name column in the tblCosting
tblrow.Range(, 5).Copy
'this pastes it into column A of hours register file
.Range("A" & Rows.Count).End(xlUp).Offset(, 2).PasteSpecial xlPasteFormulasAndNumberFormats
End With
With wsDst
'This sets column width of request number column so it can be read and is not xxxxx
.Columns("C:C").ColumnWidth = 8
'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
tblrow.Range.Resize(, 7).Copy
'This pastes in the figures in the first 7 columns starting in column A
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'This copies the first 7 columns, i.e. A:G, of the current row of the table to column A in the destination sheet.
tblrow.Range(, 10).Copy
'This pastes in the figures in the first 7 columns starting in column A
.Range("H" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
'Overwrites the numbers pasted to column I with a formula
.Range("I" & Rows.Count).End(xlUp).Offset(1).Formula = "=IF(RC[-4]=""Activities"",0,RC[-1]*0.1)"
'Overwrites the numbers pasted to column L with a formula
.Range("J" & Rows.Count).End(xlUp).Offset(1).Formula = "=RC[-1]+RC[-2]"
'Adds currency formatting to total ex gst column
.Columns(8).NumberFormat = "$#,##0.00"
'Adds Australian date format to date column
'.Range("A:A").NumberFormat = "dd/mm/yyyy"
'sort procedure copied from vba
wsDst.Sort.SortFields.Clear
wsDst.Sort.SortFields.Add Key:=Range("A4:A" & lr), _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
With Workbooks(DocYearName).Worksheets(Combo).Sort
'set range to sort of A3 to AO
.SetRange Range("A3:AO" & lr)
.header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
Next tblrow
Application.CutCopyMode = False
Application.ScreenUpdating = True
Exit Sub
'ErrorMsg:
' Select Case Err.Number
' Case 53
' MsgBox "Enable macros needs to be selected"
' End Select
End Sub
Could someone please help me with some code that will compare the 2 mentioned ranges, sheet2 in the current workbook and sheet2 in the workbook identified as wsDst and if they are different, copy the range in the workbook that holds the procedure to the workbook identified as wsDst?