Hello,
I have used this code below to split a large excel file into multiple sheets from matching column data, but now I need to split it by a partial match (set number of characters from the beginning) from beginning of the column data.
For Example:
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit;">Date Name Description1/1 Jack Safe-221/1 Jan Safe-211/2 Jake Fail-41/2 Jen Fail-31/3 Jen Dont-11/3 Matt Poop-71/4 Mike Fail331/5 Sean Safe-91/6 Pete Pooper1/8 Anne 21-43</code>
So with the code provided below using column 3 I would get 10 different sheets since none of the data in the column is identical. I want to modify the code (or come up with new code) so I can set the number of characters to compare from the beginning of the data in the set column and split into sheets based on that. So if I set it to the first 4 characters in column 3 I would receive only 5 sheets sheets: Safe, Fail, Dont, Poop, & 21-4.
Would anyone kindly assist me with the modifications or new code needed for this? I have searched for a bit with no luck, just keep finding code to check the full cell data for matches in a set column like this code I have:
SPLIT DATA FROM ONE SHEET TO MULTIPLE SHEETS
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit;">Sub parse_data()Dim lr As LongDim ws As WorksheetDim vcol, i As IntegerDim icol As LongDim myarr As VariantDim title As StringDim titlerow As Integervcol = 2 'CHANGE THE COLUMN NUMBER AS PER YOUR NEEDSet ws = Sheets("Data") 'CHANGE THE SHEET NAME AS PER YOUR NEEDlr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Rowtitle = "A1:Z1" 'CHANGE THE TITLE ROW AS PER YOUR NEEDtitlerow = ws.Range(title).Cells(1).Rowicol = ws.Columns.Countws.Cells(1, icol) = "Unique"For i = 2 To lrOn Error Resume NextIf ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Thenws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)End IfNextmyarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))ws.Columns(icol).ClearFor i = 2 To UBound(myarr)ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") ThenSheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""ElseSheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)End Ifws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")Sheets(myarr(i) & "").Columns.AutoFitNextws.AutoFilterMode = Falsews.ActivateEnd Sub</code>
I have used this code below to split a large excel file into multiple sheets from matching column data, but now I need to split it by a partial match (set number of characters from the beginning) from beginning of the column data.
For Example:
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit;">Date Name Description1/1 Jack Safe-221/1 Jan Safe-211/2 Jake Fail-41/2 Jen Fail-31/3 Jen Dont-11/3 Matt Poop-71/4 Mike Fail331/5 Sean Safe-91/6 Pete Pooper1/8 Anne 21-43</code>
So with the code provided below using column 3 I would get 10 different sheets since none of the data in the column is identical. I want to modify the code (or come up with new code) so I can set the number of characters to compare from the beginning of the data in the set column and split into sheets based on that. So if I set it to the first 4 characters in column 3 I would receive only 5 sheets sheets: Safe, Fail, Dont, Poop, & 21-4.
Would anyone kindly assist me with the modifications or new code needed for this? I have searched for a bit with no luck, just keep finding code to check the full cell data for matches in a set column like this code I have:
SPLIT DATA FROM ONE SHEET TO MULTIPLE SHEETS
<code style="margin: 0px; padding: 0px; font-style: inherit; font-weight: inherit;">Sub parse_data()Dim lr As LongDim ws As WorksheetDim vcol, i As IntegerDim icol As LongDim myarr As VariantDim title As StringDim titlerow As Integervcol = 2 'CHANGE THE COLUMN NUMBER AS PER YOUR NEEDSet ws = Sheets("Data") 'CHANGE THE SHEET NAME AS PER YOUR NEEDlr = ws.Cells(ws.Rows.Count, vcol).End(xlUp).Rowtitle = "A1:Z1" 'CHANGE THE TITLE ROW AS PER YOUR NEEDtitlerow = ws.Range(title).Cells(1).Rowicol = ws.Columns.Countws.Cells(1, icol) = "Unique"For i = 2 To lrOn Error Resume NextIf ws.Cells(i, vcol) <> "" And Application.WorksheetFunction.Match(ws.Cells(i, vcol), ws.Columns(icol), 0) = 0 Thenws.Cells(ws.Rows.Count, icol).End(xlUp).Offset(1) = ws.Cells(i, vcol)End IfNextmyarr = Application.WorksheetFunction.Transpose(ws.Columns(icol).SpecialCells(xlCellTypeConstants))ws.Columns(icol).ClearFor i = 2 To UBound(myarr)ws.Range(title).AutoFilter field:=vcol, Criteria1:=myarr(i) & ""If Not Evaluate("=ISREF('" & myarr(i) & "'!A1)") ThenSheets.Add(after:=Worksheets(Worksheets.Count)).Name = myarr(i) & ""ElseSheets(myarr(i) & "").Move after:=Worksheets(Worksheets.Count)End Ifws.Range("A" & titlerow & ":A" & lr).EntireRow.Copy Sheets(myarr(i) & "").Range("A1")Sheets(myarr(i) & "").Columns.AutoFitNextws.AutoFilterMode = Falsews.ActivateEnd Sub</code>
