Need total lines for some columns when parsing data

angil0126

New Member
Joined
Apr 9, 2018
Messages
6
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
 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Fluff

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
60,317
Office Version
  1. 365
Platform
  1. Windows
How about
Code:
   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

New Member
Joined
Apr 9, 2018
Messages
6
How about
Code:
   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

MrExcel MVP, Moderator
Joined
Jun 12, 2014
Messages
60,317
Office Version
  1. 365
Platform
  1. Windows
Glad to help & thanks for the feedback
 

Forum statistics

Threads
1,137,115
Messages
5,679,712
Members
419,852
Latest member
ddewaard17

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
Top