Forum Discussion
Refactoring an Excel spreadsheet
I would like to write a simple VBA script which does the below, and I'd really like some help filling in some blanks which I don't currently know.
Assume there is a first worksheet with about 20 columns and about a thousand rows.
For column i in range of column B to S (that is, iterating through all columns except the first):
Create a new worksheet whose name is the header (row 1) of column i. (For example, if column B, row 1 is "Weather", then the name of the new worksheet is "Weather".)
Copy all rows from column A and column i in the first worksheet to column A and B of the new worksheet. (In other words, it pairs the first column with each column, from the original worksheet, and sends each pair to a new worksheet.)
Then, for each (new) worksheet in the project, except the first, original one:
For each row in the sheet:
If the column B cell of that row is empty:
Delete that row.
(In other words, go through all of the new sheets and delete any rows with a blank entry in the second column.)
Finally,
For each (new) sheet in the workbook, except the first, original one:
For each row in the sheet:
If the cells in column A and B are an identical match to the cells in column A and B but in some other row - i.e., an exact duplicate in both cells - then delete that row.
In simpler terms, just delete any duplicate values, but it has to be a match in both columns to be considered a duplicate.
Here is my attempt at writing this in code:
Dim wb As Workbook; wb = Workbook("test")
Dim ws1 As Worksheet; ws1 = Workbook.Sheets("Sheet1")
Dim new As Worksheet
For column i in ws1.Columns(Range("B", "S")):
Set new = wb.Sheets.Add()
new.Name(column.Range(i, 1)) # attempting to extract name from cell B1, for example
cells = ws1.Copy(Column A and i)
new.paste(cells)
for sheet in Sheets 2 - 10:
for row in Rows:
if row(column(b)).isBlank():
delete(row)
if row.isDuplicate()
delete(row)
That's the basic idea. I know the code is very vague, because I will need to research a lot about the specific syntax of Visual Basic for this. In case anyone can fill in the gaps in my understand, I'd hugely appreciate it. Thanks very much.
Here you go:
Sub CreateSheets() Dim wb As Workbook Dim w1 As Worksheet Dim wn As Worksheet Dim m As Long Dim n As Long Dim c As Long Dim nm As String Dim rng As Range Dim crt As Range Application.ScreenUpdating = False Set wb = ActiveWorkbook Set w1 = wb.Worksheets(1) m = w1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row n = w1.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Set rng = w1.Cells(1, 1).Resize(m, n) Set crt = w1.Cells(1, n + 2).Resize(2) w1.Cells(2, n + 2).Value = "<>" For c = 2 To n Set wn = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)) nm = w1.Cells(1, c).Value wn.Name = nm wn.Cells(1, 1).Value = w1.Cells(1, 1).Value wn.Cells(1, 2).Value = nm w1.Cells(1, n + 2).Value = nm rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=crt, _ CopyToRange:=wn.Cells(1, 1).Resize(1, 2), Unique:=True Next c crt.ClearContents Application.ScreenUpdating = True End Sub
6 Replies
Here you go:
Sub CreateSheets() Dim wb As Workbook Dim w1 As Worksheet Dim wn As Worksheet Dim m As Long Dim n As Long Dim c As Long Dim nm As String Dim rng As Range Dim crt As Range Application.ScreenUpdating = False Set wb = ActiveWorkbook Set w1 = wb.Worksheets(1) m = w1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row n = w1.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column Set rng = w1.Cells(1, 1).Resize(m, n) Set crt = w1.Cells(1, n + 2).Resize(2) w1.Cells(2, n + 2).Value = "<>" For c = 2 To n Set wn = wb.Worksheets.Add(After:=wb.Worksheets(wb.Worksheets.Count)) nm = w1.Cells(1, c).Value wn.Name = nm wn.Cells(1, 1).Value = w1.Cells(1, 1).Value wn.Cells(1, 2).Value = nm w1.Cells(1, n + 2).Value = nm rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=crt, _ CopyToRange:=wn.Cells(1, 1).Resize(1, 2), Unique:=True Next c crt.ClearContents Application.ScreenUpdating = True End SubThanks very much for this, it works great. If you don't mind, could you please clarify for me what a few of these lines do?
m = w1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
n = w1.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
I believe this just gets the dimensions of the Excel data. Specifically, the asterisk means "anything", and it returns the index of the last row/column. Find returns a range object of all cells matching the search criterion. I don't understand what xlPrevious vs. xlNext do though.
Set rng = w1.Cells(1, 1).Resize(m, n)
Set crt = w1.Cells(1, n + 2).Resize(2)
I don't understand this. You selected the first cell, but then resized the range to the size of the data. And what is crt and why is 2 being added to n?
w1.Cells(2, n + 2).Value = "<>"
I don't understand why you entered this value for the cells.
w1.Cells(1, n + 2).Value = nm
I don't understand this line.
rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=crt, _
CopyToRange:=wn.Cells(1, 1).Resize(1, 2), Unique:=True
Or this one.
If you could explain some of these lines to me I would really appreciate it. Thank you.m = w1.Cells.Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
This says:
Search all cells for any non-blank content: What:="*"
Do so row by row: SearchOrder:=xlByRows
And start from the bottom upwards: SearchDirection:=xlPrevious
The search stops when it finds a row with at least one non-blank cell, and returns the row number of that row.
n = w1.Cells.Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
This says:
Search all cells for any non-blank content: What:="*"
Do so column by column: SearchOrder:=xlByColumns
And start from the right hand side and work your way to the left: SearchDirection:=xlPrevious
The search stops when it finds a column with at least one non-blank cell, and returns the column number of that column.
Set rng = w1.Cells(1, 1).Resize(m, n)
This sets rng to the range from Cells(1, 1) = A1 to Cells(m, n) = the cell in the last used row and column, i.e. the data range.
Set crt = w1.Cells(1, n + 2).Resize(2)
This sets crt to the range starting in row 2, two columns to the right of the data range (i.e. a range guaranteed to be outside the data range), and two rows tall. This will be the criteria range for the Advance Filter operation.
We then loop through the columns, from column 2 to n, the last used column of the data range.
nm = w1.Cells(1, c).Value
sets nm to the column header of column C. This will become the name of the new sheet, and it will also be used in the criteria range.
The top cell of the criteria range is set to this column header, and the bottom cell is set to <> meaning: not empty.
rng.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=crt, _
CopyToRange:=wn.Cells(1, 1).Resize(1, 2), Unique:=TrueThis executes the Advanced Filter action from the Data tab of the ribbon, with the option to copy the filtered data to a new range (namely the new sheet), with the criteria range specifying that the column we're looking at should be empty, and with the option to copy unique rows only, so that we won't get duplicates.
- Thanks so much, I really appreciate it. I'll study this as well as check its execution. Thank you very much.
