SOLVED

Refactoring an Excel spreadsheet

Brass Contributor

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.

 

 

 

 

 

 

6 Replies
best response confirmed by jukhamil (Brass Contributor)
Solution

@jukhamil 

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
Thanks so much, I really appreciate it. I'll study this as well as check its execution. Thank you very much.

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.

@jukhamil 

 

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.

 

S0760.png

Thanks very much.


> 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.

.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?

You pass this to the criteria range as a way of saying: do not copy any values that are just a row of two blank entries. But why isn't the crt 1 row by 2 columns, instead of 1 column by 2 rows, as I think you were saying?

Thank you very much.

@jukhamil 

 

> .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".

1 best response

Accepted Solutions
best response confirmed by jukhamil (Brass Contributor)
Solution

@jukhamil 

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

View solution in original post