Hi, I need a looping VBA macro to extract matching rows based on a column value, and to then extract the matching rows into new worksheets

[BishopLewis98]

Hi all, I am also a noob to VBA world, and here is my request.
I need a looping VBA macro to extract matching rows within a workbook based on a column value, and to extract the matching rows into new worksheets.
I have 16,000 rows and in column 5 (Column E), we have a list of names. There are multiple rows that have the same number of names from column 5 (Column E), and what I need the macro to do is to loop through the whole workbook, find any matching rows that have the same number of names in Column 5 (Column E), then extract those rows to a new worksheet in a separate workbook. Making sure that the macro runs through all of the entries in column 5 (Column E) before it finishes. Any help would be greatly appreciated!

 

[rpaulson]

 

[BishopLewis98]

Hi thanks for pointing me towards this example, I have copied the code and unfortunately I get a debug error '9'. I have replaced the column he refers to in his example "D2" to the one I need "E2". Please see the code below, I wonder if I need to amend any other fields or names to match my Excel?

Sub CreateBranchSheets()

Dim BranchField As Range
Dim BranchName As Range
Dim NewWSheet As Worksheet
Dim WSheet As Worksheet
Dim WSheetFound As Boolean
Dim DataWSheet As Worksheet

Set DataWSheet = Worksheets("Data")
Set BranchField = DataWSheet.Range("E2", DataWSheet.Range("E2").End(xlDown))

Application.ScreenUpdating = False

'Loop through each branch name in column D

For Each BranchName In BranchField

'Check whether the current branch name corresponds with an existing sheet name

For Each WSheet In ThisWorkbook.Worksheets
If WSheet.Name = BranchName Then
WSheetFound = True
Exit For ' if it does assign True to the WSheetFound variable and exit the For Each Next Loop
Else
WSheetFound = False ' if it doesn't assign False to the WSheetFound variable
End If
Next WSheet


If WSheetFound Then 'if WSheetFound = True

'copy and paste the record to the relevant worksheet, in the next available row
BranchName.Offset(0, -3).Resize(1, 17).Copy Destination:=Worksheets(BranchName.Value).Range("A1").End(xlDown).Offset(1, 0)

Else 'if WSheetFound = False

Set NewWSheet = Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)) ' insert a new Worksheet
NewWSheet.Name = BranchName 'named after that branch

DataWSheet.Range("A1", DataWSheet.Range("A1").End(xlToRight)).Copy Destination:=NewWSheet.Range("A1") 'and copy the headings to it

BranchName.Offset(0, -3).Resize(1, 13).Copy Destination:=NewWSheet.Range("A2") ' then copy and paste the record to i

End If

Next BranchName

'autofit columns in each sheet in the workbook

For Each WSheet In ThisWorkbook.Worksheets

WSheet.UsedRange.Columns.AutoFit

Next WSheet

Application.ScreenUpdating = True

End Sub

 

[BishopLewis98]

Hi all, I received this code but it isn't formatted correctly, can anyone assist to put in a correct line by line format for me?

Sub ExtractMatchingRows() Dim ws As Worksheet Dim lastRow As Long Dim i As Long, j As Long Set ws = ThisWorkbook.Sheets("Sheet1") 'Change Sheet1 to your sheet name lastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row 'Change column A to your matching column For i = 2 To lastRow 'Loop through all rows in the worksheet starting from row 2 If Not IsEmpty(ws.Range("A" & i)) Then 'Check if cell is not empty in the matching column j = j + 1 'Increment counter for new worksheets created by 1 each time a match is found Sheets("Sheet2").Copy After:=Sheets(j) 'Copy existing worksheet and rename it with incremented counter value as its name ActiveSheet.Name = "Matching Rows - " & j 'Change Matching Rows - 0 to whatever you want as prefix for each copied sheet's name With Sheets("Matching Rows - " & j) 'Referring to newly created sheet .Range("A1:Z" & lastRow).AutoFilter Field:=1, Criteria1:=ws.Range("A" & i).Value2 'Filter data based on value in the matching column (change Z to whatever your last column is) .Range("A2:Z" & .Cells(Rows.Count, 1).End(xlUp).Row).SpecialCells(xlCellTypeVisible).EntireRow.Copy Destination:=ThisWorkbook.Worksheets("Matching Rows - " & j).[a1] '(change Z and A columns according to your data range) Copy visible rows into newly created worksheet .AutoFilterMode = False '[Optional] Turn off autofilter once done filtering data End With Next i End Sub

 

[rpaulson]

Sub Create_Worksheets()
'This macro will seperate the data in  your range into individual worksheet(s)
'it will look in Column "E" of every row in your data
'it will then add that row of data into a worksheet whose sheet name is the value in colunn "E"
'if the worksheet does not exist, the code will automatically create and name the new sheet for you.

Dim rs As Worksheet
Set rs = ActiveSheet

For r = 1 To rs.Range("E" & Rows.Count).End(xlUp).Row
wsName = rs.Cells(r, "E") 

If WorksheetFunction.IsErr(Evaluate("'" & wsName & "'!A1")) = "True" Then Sheets.Add.Name = wsName     'if true then sheet does NOT exist, if False then sheet does exist

wr = Worksheets(wsName).Range("A" & Rows.Count).End(xlUp).Row + 1
rs.Rows(r).Copy Destination:=Worksheets(wsName).Range("A" & wr)

next r

rs.Activate
MsgBox "Done"

End Sub

 

[BishopLewis98]

Thank you!

 

[clh_1496]

Sub Create_Worksheets()
'This macro will seperate the data in  your range into individual worksheet(s)
'it will look in Column "E" of every row in your data
'it will then add that row of data into a worksheet whose sheet name is the value in colunn "E"
'if the worksheet does not exist, the code will automatically create and name the new sheet for you.

Dim rs As Worksheet
Set rs = ActiveSheet

For r = 1 To rs.Range("E" & Rows.Count).End(xlUp).Row
wsName = rs.Cells(r, "E")

If WorksheetFunction.IsErr(Evaluate("'" & wsName & "'!A1")) = "True" Then Sheets.Add.Name = wsName     'if true then sheet does NOT exist, if False then sheet does exist

wr = Worksheets(wsName).Range("A" & Rows.Count).End(xlUp).Row + 1
rs.Rows(r).Copy Destination:=Worksheets(wsName).Range("A" & wr)

next r

rs.Activate
MsgBox "Done"

End Sub

@rpaulson Do you know which line I would change if I want to search each of the rows with "3640" rather than the column name, the rest of the macro is the same in terms of checking the column and pasting all the rows in a different spreadsheet?