VBA Parse Data. (do not want title to copy over Every time)

Scifo

New Member
Joined
Apr 16, 2023
Messages
9
Office Version
  1. 365
Platform
  1. Windows
Hi,
I am an amateur and have taken the VBA code from Forums and edited a little - but I would appreciate any help that can be provided.
The idea is to parse data inputted weekly into one sheet into different sheets keeping a running total.
Therefore the first run would need to create the sheet tabs and headers and copy the headers.
No matter what I try I cannot get the subsequent data to copy only the relevant data without also copying the heders titles everytime.
I want to post only the row bases on column 2.

I believe this is the line
VBA Code:
SHEET_EXISTS:
        ws.Range("A" & titlerow & ":M" & lr).Copy Sheets(myarr(i) & "").Range("A" & Rows.Count).End(xlUp).Offset(1)


the full code >

VBA Code:
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
'Filtered Column Number
vcol = 2
'Worksheet to be split
Set ws = Sheets("Sheet1")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A1:M1"
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 Evaluate("=ISREF('" & myarr(i) & "'!A1)") Then GoTo SHEET_EXISTS
        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")

GoTo NEW_SHEET
SHEET_EXISTS:
        ws.Range("A" & titlerow & ":M" & lr).Copy Sheets(myarr(i) & "").Range("A" & Rows.Count).End(xlUp).Offset(1)
NEW_SHEET:

        Sheets(myarr(i) & "").Columns.AutoFit
Next
'Remove filter
ws.AutoFilterMode = False
ws.Activate
End Sub
 
Last edited by a moderator:

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
Try this instead.
VBA Code:
SHEET_EXISTS:
    ws.Range("A" & titlerow & ":M" & lr).Offset(1).Copy Sheets(myarr(i) & "").Range("A" & Rows.Count).End(xlUp).Offset(1)
 
Upvote 0
Solution
Try this instead.
VBA Code:
SHEET_EXISTS:
    ws.Range("A" & titlerow & ":M" & lr).Offset(1).Copy Sheets(myarr(i) & "").Range("A" & Rows.Count).End(xlUp).Offset(1)
Thank you for taking the time to respond.
It did what I was required. I have been playing about with it for days removing and adding things but as I say a novice?
The only change was this part ?

VBA Code:
.Offset(1)

if so I must have done something else as now not copying Column A.

But again thank you. very kind
 
Upvote 0

Forum statistics

Threads
1,224,869
Messages
6,181,490
Members
453,047
Latest member
charlie_odd

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