Sep 14 2021 07:56 AM
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.
Sep 14 2021 09:30 AM
SolutionHere 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
Sep 14 2021 09:42 AM
Sep 16 2021 08:57 AM - edited Sep 16 2021 08:57 AM
Thanks 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.
Sep 16 2021 10:20 AM
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:=True
This 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.
Sep 17 2021 02:22 AM
Sep 17 2021 03:37 AM
> .Cells(1, n+2) - this just selects a single cell in row 1, column n+2, not a rectangular selection of cells, is that correct?
> Resize(2) changes the height to 2 rows?
Both are correct.
When applying advanced filter, the criteria range has the field names (column headers) in its first row, and the conditions in the row or rows below. See Excel Advanced Filter Introduction
In the macro, the first row of crt contains the field name, and the second row contains the condition <>, meaning "not empty".
Sep 14 2021 09:30 AM
SolutionHere 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