VBA - Split table rows based on a column value

0 votes
Two columns, column A and column B, make up my table. There are values in column B for each of the types in column A. For each type, I want to make a sheet with the corresponding rows.

I tried creating a sheet and pasting the identified rows thereafter looping through each kind, but there is a lot of data and it takes a long time.

Does anybody have a more effective thought?

I tried creating a sheet and pasting the identified rows thereafter looping through each kind, but there is a lot of data and it takes a long time.
Apr 7 in Others by narikkadan
• 63,040 points
152 views

1 answer to this question.

0 votes

Create Type-Specific Worksheets in Excel using VBA

enter image description here

Description

  • This is a VBA code for creating type-specific worksheets in Excel based on a unique column value in a source worksheet.

  • The code first defines constants for the source worksheet name and the column that contains the unique values. It then sets up variables for the workbook, source worksheet, source data range, and a dictionary object for grouping data by unique values.

  • The code then loops through the source data, adds each unique value to the dictionary, and adds the corresponding row numbers to a collection within the dictionary.

  • The code then creates a new worksheet as a template for the type-specific worksheets and clears any existing data. It then loops through the dictionary, creating a new worksheet for each unique value and copying the rows from the source data that correspond to that value.

  • If a worksheet with the same name already exists, the code deletes it first to avoid conflicts. Once all the type-specific worksheets have been created, the template worksheet is deleted.

  • Finally, the code displays a message box to inform the user that the process is complete.

The Code

Sub CreateTypeWorksheets()

    ' Define constants.
    
    Const SRC_NAME As String = "Sheet1"
    Const UNIQUE_COLUMN As Long = 1
    
    Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
    
    ' Write the source data to an array.
    
    Dim sws As Worksheet: Set sws = wb.Sheets(SRC_NAME)
    
    Dim srg As Range, srCount As Long, cCount As Long
    
    With sws.Range("A1").CurrentRegion
        srCount = .Rows.Count - 1
        cCount = .Columns.Count
        Set srg = .Resize(srCount).Offset(1)
    End With
    
    Dim sData(): sData = srg.Value
    
    ' Populate a dictionary with the unique types
    ' and their corresponding row numbers.
    
    Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
    dict.CompareMode = vbTextCompare
    
    Dim sr As Long, sStr As String
    
    For sr = 1 To srCount
        sStr = CStr(sData(sr, UNIQUE_COLUMN))
        If Not dict.Exists(sStr) Then Set dict(sStr) = New Collection
        dict(sStr).Add sr
    Next sr
    
    ' Create the template worksheet.
    
    Application.ScreenUpdating = False
    
    sws.Copy After:=wb.Sheets(wb.Sheets.Count)

    Dim tws As Worksheet: Set tws = wb.Sheets(wb.Sheets.Count)

    With tws.Range("A1").CurrentRegion
        .Resize(srCount).Offset(1).Clear
    End With
    
    ' Create the type-specific worksheets.
        
    Dim dsh As Object, dData(), Key, rItem, dr As Long, c As Long
    
    For Each Key In dict.Keys
        ' Write to an array.
        ReDim dData(1 To dict(Key).Count, 1 To cCount)
        For Each rItem In dict(Key)
            dr = dr + 1
            For c = 1 To cCount
                dData(dr, c) = sData(rItem, c)
            Next c
        Next rItem
        ' Delete existing worksheet.
        On Error Resume Next
            Set dsh = wb.Sheets(Key)
        On Error GoTo 0
        If Not dsh Is Nothing Then
            Application.DisplayAlerts = False ' delete without confirmation
                dsh.Delete
            Application.DisplayAlerts = True
            Set dsh = Nothing ' reset for the next iteration
        End If
        ' Create the worksheet.
        tws.Copy After:=wb.Sheets(wb.Sheets.Count)
        ' Copy data from the array.
        With wb.Sheets(wb.Sheets.Count)
            .Name = Key
            .Range("A2").Resize(dr, cCount).Value = dData
        End With
        dr = 0 ' reset for the next iteration
    Next Key
    
    ' Delete the template worksheet.
    
    Application.DisplayAlerts = False ' delete without confirmation
        tws.Delete
    Application.DisplayAlerts = True

    ' Inform.

    Application.ScreenUpdating = True
    
    MsgBox "Type worksheets created.", vbInformation

End Sub
answered Apr 7 by Kithuzzz
• 38,010 points

Related Questions In Others

0 votes
1 answer

VBA Help to find a column based on header value and cupy it to an other worksheet

You can break out the "copy column ...READ MORE

answered Jan 26 in Others by narikkadan
• 63,040 points
304 views
0 votes
1 answer

VBA Loop to select then copy a range of cells based on value in column B

Try this: Sub Macro2() Dim ...READ MORE

answered Mar 23 in Others by narikkadan
• 63,040 points
279 views
0 votes
1 answer

Repeated excel rows based on a cell with multiple values

You can use this query: let ...READ MORE

answered Oct 20, 2022 in Others by narikkadan
• 63,040 points
422 views
0 votes
1 answer

Formula for inserting a thumbnail picture into excel cell, based on another cell's value

Here is a really excellent tutorial on ...READ MORE

answered Oct 31, 2022 in Others by narikkadan
• 63,040 points
472 views
0 votes
1 answer

Retrieve epay.info Balance with VBA and Excel

This code should log you in, provided ...READ MORE

answered Sep 5, 2018 in Blockchain by digger
• 26,740 points
632 views
0 votes
1 answer

How to load file to Excel Power query from SFTP site

Currently, I don't think there is a ...READ MORE

answered Dec 3, 2018 in Power BI by Upasana
• 8,620 points
2,719 views
0 votes
1 answer

Using VBA Excel to create a gramatically correct list

The Excel AND function is a logical ...READ MORE

answered Feb 9, 2022 in Others by gaurav
• 22,980 points
187 views
0 votes
2 answers

How to copy a formula horizontally within a table using Excel VBA?

Hi so basically, create an adjacent column ...READ MORE

answered Feb 16, 2022 in Others by Edureka
• 13,630 points
448 views
0 votes
1 answer
0 votes
1 answer
webinar REGISTER FOR FREE WEBINAR X
REGISTER NOW
webinar_success Thank you for registering Join Edureka Meetup community for 100+ Free Webinars each month JOIN MEETUP GROUP