How to omit rows from Sub parse data VBA

[Ninzzii]

Hi

Please could someone help me modify the below VBA? I am trying to omit the first 6 rows (only 2 are populated) so that when the split into different worksheets occurs, the first 6 rows are not part of the split. I am a macro novice so if you could make it easy to understand, that would be much appreciated. Also, I was trying to use two rows for my header (title from A5:P6), however this didn't seem to work and I have had to resort to using A6:P6, if there is a way of using two rows, please could you let me know?

Many thanks in advance.

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 = 11
Set ws = Sheets("Cross Co Recharges")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A6:P6"
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

[xladept]

Hi Ninzzii,

Welcome to the Forum!

Sorry to say that:

Your post does not comply with Rule 3 of our Forum RULES. Use code tags around code.

Posting code between [CODE] [/CODE] tags makes your code much easier to read and copy for testing, it also maintains VBA formatting.

Highlight your code and click the # icon at the top of your post window. More information about these and other tags can be found here

Please attend to this directly.

[Ninzzii]

Hi there. Thank you for your help so far. I have now amended it as you have advised. Please could you now help me with the query?

Many thanks.

[xladept]

Hi Ninzzii,

Thanks for the rep!

You say it's working and all you want is to skip the first 6 entries - try:

For i = 8 To UBound(myarr)

But, if that doesn't work then:

Attach a sample workbook. Make sure there is just enough data to demonstrate your need. Include a BEFORE sheet and an AFTER sheet in the workbook if needed to show the process you're trying to complete or automate. Make sure your desired results are shown, mock them up manually if necessary.

Remember to desensitize the data.

Click on GO ADVANCED and then scroll down to Manage Attachments to open the upload window.

[Ninzzii]

Hi

Please see attached workbooks. Parse data macro is splitting the "before" workbook by column K. "Currently after" is what I'm getting (the red tabs need not be part of the split), so the "desired" is what I would like it to look like.

Many thanks for your help.

[xladept]

This seems to do it:

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 = 11
Set ws = Sheets("Cross Co Recharges")
lr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Row
title = "A6:P6"
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 _
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 = WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))
ws.Columns(icol).Clear
For i = 4 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

[Ninzzii]

It works! Thank you soooo much!!

[Ninzzii]

It works! Thank you soooo much!!

[xladept]

You're welcome!