Need total lines for some columns when parsing data

[angil0126]

Hi -
I'm using this code to parse data from another sheet and it's working perfectly. However, I want to also add a total of each column from H to AM on each newly created worksheet. Is this possible? My issue with other codes I've found is that you have to specify the names of worksheets or all worksheets. In my case, the number of created worksheets changes and I only want the totals on the created worksheets, not each worksheet (there are 4 others). Any help would be greatly appreciated.

Sub parse_data()
Dim lr As Long
Dim ws As Worksheet
Dim vcol, i As Integer
Dim iCol As Long
Dim myarr As Variant
Dim title As String
Dim titlerow As Integer
vcol = 3
Set ws = Sheets("Job Report")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:AN1"
titlerow = ws.Range(title).Cells(1).Row
iCol = ws.Columns.Count
ws.Cells(1, iCol) = "Unique"
For i = 2 To lr
On Error Resume Next
If ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(iCol), 0) = 0 Then
ws.Cells(ws.Rows.Count, iCol).End(xlUp).Offset(1) = ws.Cells(i, vcol)
End If
Next
myarr = Application.WorksheetFunction.Transpose(ws.Columns(iCol).SpecialCells(xlCellTypeConstants))
ws.Columns(iCol).Clear
For i = 2 To UBound(myarr)
ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""
If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then
Sheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""
Else
Sheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)
End If
ws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
Sheets(myarr(i) & "").Columns.AutoFit
Next
ws.AutoFilterMode = False
ws.Activate




End Sub

I should mention, I am using this code successfully on two other sheets, but it's specific to those sheets and not sure how to or if I can incorporate this into the parse code somehow

Dim lastrow2 As Long

lastrow2 = Cells(Rows.Count, "J").End(xlUp).Row

Cells(lastrow2 + 2, "H").Resize(1, 32) = "=SUM(H2:H" & lastrow2 & ")"
With Range("H" & lastrow2 + 2, "AM" & lastrow2 + 2).Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThick
End With

 

[Fluff]

How about

   End If
   WS.Range("A" & titlerow & ":A" & LR).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
   With Sheets(myarr(i) & "")
      .Columns.AutoFit
      lastrow2 = .Cells(Rows.Count, "J").End(xlUp).Row
      .Cells(lastrow2 + 2, "H").Resize(1, 32).FormulaR1C1 = "=SUM(r2c:r[-2]c)"
      With .Range("H" & lastrow2 + 2, "AM" & lastrow2 + 2).Borders(xlEdgeTop)
         .LineStyle = xlContinuous
         .Weight = xlThick
      End With
   End With
Next

 

[angil0126]

How about

   End If
   WS.Range("A" & titlerow & ":A" & LR).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")
   With Sheets(myarr(i) & "")
      .Columns.AutoFit
      lastrow2 = .Cells(Rows.Count, "J").End(xlUp).Row
      .Cells(lastrow2 + 2, "H").Resize(1, 32).FormulaR1C1 = "=SUM(r2c:r[-2]c)"
      With .Range("H" & lastrow2 + 2, "AM" & lastrow2 + 2).Borders(xlEdgeTop)
         .LineStyle = xlContinuous
         .Weight = xlThick
      End With
   End With
Next

Worked Perfectly!! Thank you so much!

 

[Fluff]

Glad to help & thanks for the feedback