First Post: Macro / VBA to Move Entire Rows to New Sheets Based on Multiple Criteria From a List In A Separate Column

[jholly1984]

Hi everyone,

First I just want to say thank you to everyone who has been part of this site and community over the years. I have learned a ton and it is very much appreciated.

For this post, I am currently working on a problem that I have been unable to fully solve. There have been others posts on here and on Youtube that look at moving rows to another sheet based on criteria... but I have not seen one that looks at moving cells to different sheets based on dynamic criteria in a list. Hoping someone might be able to help.

Here is a quick view of what my sheet looks like:

Goal: I would like to be able to copy all rows to a new sheet where the keyword in column a CONTAINS the filter word in column H. Each filter in H would need to have its own sheet.

So... go through column A, identify all keywords that contain "laptop" and copy them to a new sheet called "Laptop". Then do the same each of the filter words in column H and create new sheets for each.

I have seen some options that move based on a specific cell value or a date.. but I have not been able to find anything that a) checks based on a full list of values in a column or b) extracts data based on if the cell 'contains' the filter).

I am hopnig the macros can identify and group the keyword sets automatically vs having to manually filter and assign a category in a separate column.

Hope that makes sense. Thank you for your time. Very much appreciated.

 

[jolivanes]

Based on your filter Column being Column H and Columns I and J are free to use for occurences and percentage.
Check the numbers to make sure the formulas are right.

Sub Maybe()
Dim c As Range, i As Long, sh1 As Worksheet
'If ThisWorkbook.Sheets.Count > 3 Then MsgBox "Delete previously added sheets firts!": Exit Sub
Application.ScreenUpdating = False
Set sh1 = Worksheets("Sheet2")    '<-----Sheet with all the data. Change as required
    With sh1.Range("H2:H" & Cells(Rows.Count, 8).End(xlUp).Row)
        With .Offset(, 1)
            .Formula = "=COUNTIF(R2C1:R" & Cells(Rows.Count, 1).End(xlUp).Row & "C1,""*""&RC[-1]&""*"")"
            .Value = .Value
        End With
        With .Offset(, 2)
            .Formula = "=RC[-1] / Sum(R2C9:R" & Cells(Rows.Count, 9).End(xlUp).Row & "C9)"
            .Value = .Value
            .Cells.NumberFormat = "0.00%"
        End With
    End With
    For Each c In sh1.Range("H2:H" & Cells(Rows.Count, 8).End(xlUp).Row)
    If Not [ISREF(c.Value!A1)] Then Sheets.Add(, Sheets(Sheets.Count)).Name = c.Value
        For i = 2 To sh1.Cells(Rows.Count, 1).End(xlUp).Row
            If InStr(sh1.Cells(i, 1), c) > 0 Then
                With Sheets(c.Value)
                    .Cells(1, 1).Resize(, 6).Value = sh1.Cells(1, 1).Resize(, 7).Value
                    .Cells(Rows.Count, 1).End(xlUp).Offset(1).Resize(, 6).Value = sh1.Cells(i, 1).Resize(, 6).Value
                    .Columns(1).ColumnWidth = 30
                End With
            End If
        Next i
    Next c
sh1.Select    '<-----Sheet with all the data. Change as required
Application.ScreenUpdating = True
End Sub

 

[jholly1984]

Hey there. Just wanted to quickly cycle back to this to say thank you again for the help. We saved a lot of time and now have a great process going forward.

 

[jolivanes]

Thank you for the feedback, very much appreciated.
Good Luck

 

[jholly1984]

Hi jolivanes....

Things are progressing quite well with the project based on your feedback. Thank you. There is a new wrinkle that just popped up and hoping their might be a simple macro solution.

Here is the new problem that has come up.

Once we have a list of segmented sheets by topic we need to be able to repackage it up as a pivot table in a summary view.

So

Tab 1 = Category 1
Tab 2 = Category 2
Tab 3 = Category 3
Tab = Etc.

We are looking at building a summary pivot table that breaks down the data in one sheet.

Eg Pivot Output:
Pivot Line 1 - Cat 1 (sheet 1) - Vacuum
> Domain (Domain ranking)
> URL (Pages that rank)
> Keywords (Keywords of each page that rank)

Pivot - Line 2 - Cat 2 (sheet 2) - Air Fryer
> Domain (Domain ranking)
> URL (Pages that rank)
> Keywords (Keywords of each page that rank)

In order to build this view I think what makes the most sense is to be able to add a column in every sheet that assigns the category to the sheet using the sheet name itself.

So for the vacuum sheet... we would want to be able to add column that spits out 'vacuum' all the way down to assign each row to its appropriate category.

Current challenge: Is it possible to assign the category column en masse for all the sheets that we have created from the previous macro?

Hope that makes sense.

 

[jholly1984]

This function seems to work well for an individual cell and a specific sheet (found online)
=MID(CELL("filename",A1),FIND("]",CELL("filename",A1))+1,255)

Now just trying to figure out how to do that for many sheets at once.

 

[jolivanes]

I have never worked with pivot tables so I am sorry to say that I can't help with that.
It might be better to start a new thread and ask the questions for that so you get some fresh eyes looking at your problem.
Sorry about that.

 

[jholly1984]

no worries Thanks for the note. Just added a new thread.