1

The goal is to split my Raw Data into new sheets based on unique values found in 1 column. I found the following VBA code that does what I need however the customer I will be utilizing this for has a locked excel "workbook" that I cannot change the order of the Raw Data columns on. With that being the case, this VBA code utilizes column A however my target column is C.

The new sheets also seem to name after whatever the target data is but I would like to know how to change this so I can specify a cell for the sheet name.

Question 1: What part of this code can I change to make the target column C instead of A. Question 2: How can I change the .name portion to be the value in AF2 on each sheet?

Sub parse_data() Dim xRCount As Long Dim xSht As Worksheet Dim xNSht As Worksheet Dim I As Long Dim xTRrow As Integer Dim xCol As New Collection Dim xTitle As String Dim xSUpdate As Boolean Set xSht = ActiveSheet On Error Resume Next xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row xTitle = "A1:AD1" xTRrow = xSht.Range(xTitle).Cells(1).Row For I = 2 To xRCount Call xCol.Add(xSht.Cells(I, 1).Text, xSht.Cells(I, 1).Text) Next xSUpdate = Application.ScreenUpdating Application.ScreenUpdating = False For I = 1 To xCol.Count Call xSht.Range(xTitle).AutoFilter(1, CStr(xCol.Item(I))) Set xNSht = Nothing Set xNSht = Worksheets(CStr(xCol.Item(I))) If xNSht Is Nothing Then Set xNSht = Worksheets.Add(, Sheets(Sheets.Count)) xNSht.Name = CStr(xCol.Item(I)) Else xNSht.Move , Sheets(Sheets.Count) End If xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1") xNSht.Columns.AutoFit Next xSht.AutoFilterMode = False xSht.Activate Application.ScreenUpdating = xSUpdate

End Sub

EDIT TO INCLUDE CUSTOMER TEMPLATE I AM REQUIRED TO USE https://www.dropbox.com/scl/fi/qb9484lmdyeo1aieqlb4m/HDTemplate.xlsx?dl=0&rlkey=6dlt1nlo8lehmnpl8cdipwbkp

Improve this question
4
  • it seems you're trying to recreate functions already available in the heinous application called Excel Commented Dec 3, 2021 at 0:29
  • What do you mean by target? The name of the worksheets? Sorting? Commented Dec 3, 2021 at 0:46
  • The VBA code creates a new sheet for each unique value in column A. If Column A has values Tree, Cactus, Oats, Cactus, then it will create three new sheets. One for Tree, one for cactus, and one for Oats. I need this to be column C instead of A. Commented Dec 3, 2021 at 0:48
  • @Blackmagic42 gotcha, let me know if that doesn't work. I didn't test the name portion. Commented Dec 3, 2021 at 0:57

1 Answer 1

Reset to default
2

UPDATED I'm pretty sure my first answer should work in a normal setting which makes me think there's something else going on. However, if resorting the columns is all you need, consider this macro which just makes a new worksheet. For the record this is pretty inefficient to begin with. You could use pivot tables the Filter function or probably lots of other options to do whatever you need. But anyway....

Sub fixYourData() Dim tempWS As Worksheet, pullWs As Worksheet, rNum As Long pullWs = ActiveSheet rNum = pullWs.Cells(Rows.Count, 1).End(xlUp).Row Set tempWS = Worksheets.Add With tempWS .Range("A1:A" & rNum).Value = xSht.Range("C1:C" & rNum).Value .Range("B1:B" & rNum).Value = xSht.Range("B1:B" & rNum).Value .Range("C1:C" & rNum).Value = xSht.Range("A1:A" & rNum).Value .Range("D1:AD" & rNum).Value = xSht.Range("D1:AD" & rNum).Value End With Call parse_data '<--- will run your original macro End Sub

First Answer See below code changes and comments to your questions.

Sub parse_data() Dim xRCount As Long Dim xSht As Worksheet Dim xNSht As Worksheet Dim I As Long Dim xTRrow As Integer Dim xCol As New Collection Dim xTitle As String Dim xSUpdate As Boolean Set xSht = ActiveSheet On Error Resume Next xRCount = xSht.Cells(xSht.Rows.Count, 1).End(xlUp).Row xTitle = "A1:AD1" xTRrow = xSht.Range(xTitle).Cells(1).Row For I = 2 To xRCount Call xCol.Add(xSht.Cells(I, 3).Text, xSht.Cells(I, 3).Text) '<---Q1 here Next xSUpdate = Application.ScreenUpdating Application.ScreenUpdating = False For I = 1 To xCol.Count Call xSht.Range(xTitle).AutoFilter(3, CStr(xCol.Item(I))) '<---Q1 here Set xNSht = Nothing Set xNSht = Worksheets(CStr(xCol.Item(I))) If xNSht Is Nothing Then Set xNSht = Worksheets.Add(, Sheets(Sheets.Count)) Else xNSht.Move , Sheets(Sheets.Count) End If xSht.Range("A" & xTRrow & ":A" & xRCount).EntireRow.Copy xNSht.Range("A1") xNSht.Columns.AutoFit xNSht.Name = xNSht.Range("AF2").Value ' <-- Q2 here Next xSht.AutoFilterMode = False xSht.Activate Application.ScreenUpdating = xSUpdate End Sub
Improve this answer
Sign up to request clarification or add additional context in comments.

5 Comments

This duplicated the raw data sheet and only renamed the first sheet, the rest were generic "SheetXYZ". Each "unique" value has 1 duplicate entry in the column so each sheet should only populate with 2 rows of data. Frustratingly enough if I could just move my column C to A I wouldn't have to edit the code at all....
I'm pretty sure that should work, or else something is happening that's not being shown. However if you want to just transpose some columns
Of course I could do this manually with formulas and pivot tables however I have to split each unique value in column C onto a completely separate workbook using the template the customer sent me. I have around 250 unique values this time with another report happening each week for the next several months. Unfortunately I am unable to transpose the columns as the workbook I am required to use has locked ranges preventing that. I'll add it to my OP for reference.
You are correct in that your original solution should work however the template my customer provided seems to interfere with this functioning properly even with the data fix you provided. It just duplicates all of the rows to however each new sheet it creates. Very frustrating.
@Blackmagic42 agreed it's frustrating... particularly when a viable solution was posted and not accepted. Sorry it's not working, but surely you can appreciate how an accurate answer remains pending due to something to do with your customer.... Anyway... good luck.

Start asking to get answers

Find the answer to your question by asking.

Ask question

Explore related questions

See similar questions with these tags.