Copy formulas using VBA

dpaton05

Well-known Member
Joined
Aug 14, 2018
Messages
2,392
Office Version
  1. 365
  2. 2016
Platform
  1. Windows
How do I modify this code to copy formulas from column I & J of the table tblCosting, of the row being copied to the file, whose name is stored in column 36 or 37 of the particular row? I am still learning to code so I tried to write several lines in the middle but they didn’t work. This code successfully copies the rows to the relevant sheet. The only problem is I need it to copy the tax and total formula too.
Code:
Sub cmdCopy()

          Dim wsDst As Worksheet
          Dim wsSrc As Worksheet
          Dim tblrow As ListRow
          Dim Combo As String
          Dim sht As Worksheet
          Dim tbl As ListObject
          Dim LastRow As Long
          Dim DocYearName As String
          
          Application.ScreenUpdating = False
          'assign values to variables
          
          Set tbl = ThisWorkbook.Worksheets("Costing_tool").ListObjects("tblCosting")
          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
              Combo = tblrow.Range.Cells(1, 26).Value
              'lastrow = Worksheets(Combo).Cells(Rows.Count, "A").End(xlUp).Row + 1                                    'number of first empty row in column A of Combo
                  
              If tblrow.Range.Cells(1, 6).Value = "Anglicare Western" Then
                  DocYearName = tblrow.Range.Cells(1, 37).Value
              Else
                  DocYearName = tblrow.Range.Cells(1, 36).Value
              End If
              Set wsDst = Workbooks(DocYearName).Worksheets(Combo)
                  With wsDst
                      'This copies the first 10 columns, i.e. A:J, of the current row of the table to column A in the destination sheet.
                      tblrow.Range.Resize(, 8).Copy
                      .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
                      
                      
                      
  [B]                    tblrow.Range(Cells(1, 9), Cells(1, 10)).Copy         ‘This is the two lines of code I tried to put in[/B]
  [B]                    .Cells.Range(1, 9).PasteSpecial xlPasteFormulas[/B]
                      
                      
  '.Range("A" & Rows.Count).End(xlUp).Offset(8).PasteSpecial xlPasteFormulas
                      
                      'This should go to the 15th column in the current row, i.e. column O, and copy that column and the next 2 columns, i.e. O:Q, to column K on the destination sheet.
                          'tblrow.Range.Offset(, 14).Resize(, 3).copy
                          '.Range("K" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                      'Similarly this should copy columns AD:AF from the table to column N on the destination sheet.
                          'tblrow.Range.Offset(, 29).Resize(, 3).copy
                          '.Range("N" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
                      'Sort rows based on date
                          Rows("3:1000").Select
                          Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Clear
                          Workbooks(DocYearName).Worksheets(Combo).Sort.SortFields.Add Key:=Range("A4:A1000"), _
                              SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                                  With Workbooks(DocYearName).Worksheets(Combo).Sort
                                      .SetRange Range("A3:AJ1000")
                                      .header = xlYes
                                      .MatchCase = False
                                      .Orientation = xlTopToBottom
                                      .SortMethod = xlPinYin
                                      .Apply
                                  End With
                  End With
          Next tblrow
          
          Application.CutCopyMode = False
          Application.ScreenUpdating = True
  End Sub

If you need the actual formulas I need entering, they are
I =IF(E5="*Activities",0,[Price
ex. GST]*0.1)


J =IF(E5="Activities",[@[Price
ex. GST]],[GST]+[Price
ex. GST])

and they need to go in the same spot in the destination workbook, columns I and J.


Thanks,
Dave
 
Last edited:

Excel Facts

How to find 2nd largest value in a column?
MAX finds the largest value. =LARGE(A:A,2) will find the second largest. =SMALL(A:A,3) will find the third smallest
Can you upload a copy of your "2017 - 2018 NPSS Work Allocation Sheet.xlsm" workbook so I can test a possible solution?
 
Upvote 0
Here is the link to the 2018-2019 NPSS Work Allocation Sheet:
https://www.dropbox.com/s/888j84blv82a09v/2018 - 2019 NPSS Work Allocation Sheet.xlsm?dl=0

Here is the link to the 2018-2019 Internal Work Allocation Sheet:
https://www.dropbox.com/s/9ur2snvnm78kj40/2018 - 2019 Internal Work Allocation Sheet.xlsm?dl=0

The only difference between the different yearly documents is the name, for instance, the document 2017-2018 NPSS Work Allocation Sheet you requested would be the same as the 2018 - 2019 NPSS Work Allocation Sheet but wth a different name. The same goes for the Internal Work Allocation Sheets.


Thanks Mumps,
Dave
 
Upvote 0
Place these 2 lines of code:
Code:
.Range("I" & .Range("I" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[1]C[-4]=""*Activities"",0,RC[-1]*0.1)"
.Range("J" & .Range("J" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[1]C[-5]=""*Activities"",RC[-2],RC[-1]+RC[-2])"
under this line:
Code:
.Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteValuesAndNumberFormats
 
Upvote 0
I placed the two lines of code in my procedure and I tried it and it wouldn't work. I tried to read the code and understand it:

Code:
                    tblrow.Range.Resize(, 8).Copy
                    .Range("A" & Rows.Count).End(xlUp).Offset(1).PasteSpecial xlPasteFormulasAndNumberFormats
                    .Range("I" & .Range("I" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[1]C[-4]=""*Activities"",0,RC[-1]*0.1)"
                    .Range("J" & .Range("J" & .Rows.Count).End(xlUp).Row).Formula = "=IF(R[1]C[-5]=""*Activities"",RC[-2],RC[-1]+RC[-2])"

I changed the tblrow.range.resize(,8).copy to be tblrow.range.resize(,10).copy and it seemed to work fine. Thanks for that.
 
Upvote 0

Forum statistics

Threads
1,224,823
Messages
6,181,183
Members
453,020
Latest member
Mohamed Magdi Tawfiq Emam

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top