Separate a column data into two based on text in one column

Question

In my excel, C column always will have text either response or resolution . My goal is to separate A:C columns based on this. If C column has text response, Copy A:C column to E:G otherwise copy A:C to I:K

I am using below code now:

    Sub SLACalc()
    Dim DTA As Workbook
    Dim SLADATA As Worksheet

    Set DTA = Excel.Workbooks("main.xlsm")
    Set SLADATA = DTA.Worksheets("SLA DATA")

    For i = 2 To SLADATA.Cells(Rows.Count, "A").End(xlUp).Row

        If InStr(Cells(i, "C").Value, "response") > 0 Then

            SLADATA.Cells(i, "E").Value = SLADATA.Cells(i, "A").Value
            SLADATA.Cells(i, "F").Value = SLADATA.Cells(i, "B").Value
            SLADATA.Cells(i, "G").Value = SLADATA.Cells(i, "C").Value

         Else

            SLADATA.Cells(i, "I").Value = SLADATA.Cells(i, "A").Value
            SLADATA.Cells(i, "J").Value = SLADATA.Cells(i, "B").Value
            SLADATA.Cells(i, "K").Value = SLADATA.Cells(i, "C").Value

        End If
    Next i

End Sub

This is working fine when I have less row in A:C. Now I have rows close to 20,000 and facing lot performance issues with excel. Is there anyway I can improve code to run it faster.

Adding `Application.ScreenUpdating = False` will reduce the duration. — Tony Dallimore, May 02 '20 at 10:14
Read your entire data into a VBA array (one line of code); Do the split into another VBA array in code; then write it back to the worksheet (also one line of code). The multiple worksheet read/writes are what is taking all the time. — Ron Rosenfeld, May 02 '20 at 11:20

Naresh · Accepted Answer · 2020-05-02T14:38:05.877

Assuming you want to split the table on the same row as per you code

First,

You can reduce your loop code like

For i = 2 To SLADATA.Cells(Rows.Count, "A").End(xlUp).Row
    If InStr(Cells(i, "C").Value, "response") > 0 Then
        SLADATA.Range(Cells(i, "E"), Cells(i, "G")).Value = SLADATA.Range(Cells(i, "A"), Cells(i, "C")).Value
     Else
        SLADATA.Range(Cells(i, "I"), Cells(i, "K")).Value = SLADATA.Range(Cells(i, "A"), Cells(i, "C")).Value
    End If
Next i

Second

Try Array: Arrays help reduce process time substantially.

Sub SLACalc2()
    Dim DTA As Workbook
    Dim SLADATA As Worksheet
    Set DTA = Excel.Workbooks("main.xlsm")
    Set SLADATA = DTA.Worksheets("SLA DATA")
    LRow = SLADATA.Cells(Rows.Count, "A").End(xlUp).Row
    DataArr = SLADATA.Range("A2:C" & LRow).Value

    For i = 1 To UBound(DataArr)
        If Application.Index(DataArr, i, 3) = "response" Then
            SLADATA.Range(Cells(i + 1, "E"), Cells(i + 1, "G")).Value = Application.Index(DataArr, i)
         Else
            SLADATA.Range(Cells(i + 1, "I"), Cells(i + 1, "K")).Value = Application.Index(DataArr, i)
        End If
    Next i

End Sub

With this timer ; I could check the process time. The first method is faster. May be because, it avoids storing and retrieving data from an array.

But if you just want separate tables as suggested by Ron Rosenfeld in his comment to the question, it is better to use autofilter. It will work faster than array.

Sub Macro1()
    Dim DataRng As Range
    Set DataRng = Range("A1:C" & Cells(Rows.Count, "A").End(xlUp).Row)

    DataRng.AutoFilter Field:=3, Criteria1:="=*response*"
    DataRng.Cells.SpecialCells(xlCellTypeVisible).Copy
    Range("E1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    DataRng.AutoFilter Field:=3, Criteria1:="=*resolution*"
    DataRng.Cells.SpecialCells(xlCellTypeVisible).Copy
    Range("I1").Select
    ActiveSheet.Paste
    Application.CutCopyMode = False

    ActiveSheet.ShowAllData

End Sub

thanks method 1 and 2 still taking time. Seems like last code has some issues. It just copy first row data into I:K — acr, May 02 '20 at 14:17
Criteria1:="response" I hope this check for cell contains only this specific word. In my C column I have some other text along with this key word — acr, May 02 '20 at 14:21
Then you can make it Criteria1:= "=*response*" .. Edited answer — Naresh, May 02 '20 at 14:35
Thanks. Thats worked and running smoothly without any issues — acr, May 02 '20 at 14:43

Separate a column data into two based on text in one column

1 Answers1