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, 2023 in Others by narikkadan
• 63,600 points
1,283 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, 2023 by Kithuzzz
• 38,000 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, 2023 in Others by narikkadan
• 63,600 points
2,420 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, 2023 in Others by narikkadan
• 63,600 points
2,364 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,600 points
1,545 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,600 points
1,546 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
1,259 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
3,696 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
• 23,260 points
971 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,690 points
1,089 views
0 votes
1 answer
0 votes
1 answer

Loop through each cell in a given range and change the value depending on value in a column in the same row

Use match() and if() without code at ...READ MORE

answered Mar 26, 2023 in Others by Kithuzzz
• 38,000 points
923 views
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