SOLVED

Split data with the help of VBA

Iron Contributor

Hello Everyone,

I am trying to create a unique list from the given input. A sample data as input and corresponding output which is expected, I have attached here. any help on writing a vba would be appreciated.

Screenshot 2022-02-15 165251.png

 

 I want to split data. 

Description of data set : In input table, you can see 6 rows excluding header row.  In cat1 column for 'a' value there is corresponding two different values in cat2 column and blank cell in column2.

I am trying to do below two things :

1.  Eliminate rows which has blank cell in either cat1 or cat2. In the shared sample data set, it is available in cat2 only.

2. Create two tables from the input table with below features:

     a. Table 1 : only contain values from cat1 column which has one to one mapping with corresponding values in cat2 column e.g. "c"

     b. Table 2 : only contain values from cat1 column which has multiple mapping with corresponding values in cat2 column e.g. "a"

 

So, what should i write in VBA ?

 

Please help..

 

Here is a attached file..

7 Replies
best response confirmed by Peter Bartholomew (Silver Contributor)
Solution

@Excel 

Sub SplitData()
    Dim r As Long
    Dim s As Long
    Dim t As Long
    Dim m As Long
    Application.ScreenUpdating = False
    m = Range("C:D").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("I5:M" & Rows.Count).Clear
    s = 4
    t = 4
    For r = 5 To m
        If Range("C" & r).Value <> "" And Range("D" & r).Value <> "" Then
            If Application.CountIfs(Range("C5:C" & m), Range("C" & r).Value, Range("D5:D" & m), "<>") = 1 Then
                s = s + 1
                Range("C" & r).Resize(1, 2).Copy Destination:=Range("I" & s)
            Else
                t = t + 1
                Range("C" & r).Resize(1, 2).Copy Destination:=Range("L" & t)
            End If
        End If
    Next r
    Application.ScreenUpdating = True
End Sub
Thank you so much sir.

@Hans Vogelaar 

Hello Sir,

Can you please explain above VBA code?

@Excel 

The code starts by finding the last used row in columns C and D. This is assigned to the variable m.

Next, it removes existing results in columns I to M below row 4.

The variables s and t are initialized to 4 (the header row for the results). s is for columns I and J, t for columns L and M.

The variable r loops through rows 5 to m. If both column C and column D in row r are not blank, we use COUNTIFs to check whether the value in column C occurs only once, with a non-blank value in D, or more than once. If once, increase the row number s and copy C / D to I /J, otherwise increase the row number t, and copy C / D to L / M.

@Excel 

... and without VBA

"Multiplicity=1"
= LET(
    multiplicity, COUNTIFS(Cat_1,Cat_1, Cat_2,"<>"),
    FILTER(input, (multiplicity=1)*(Cat_2<>""))
  )

"Multiplicity>1"
= LET(
    multiplicity, COUNTIFS(Cat_1,Cat_1, Cat_2,"<>"),
    FILTER(input, (multiplicity>1)*(Cat_2<>""))
  )

@Hans Vogelaar 

Thank you so much sir. 

Thank you so much sir.
1 best response

Accepted Solutions
best response confirmed by Peter Bartholomew (Silver Contributor)
Solution

@Excel 

Sub SplitData()
    Dim r As Long
    Dim s As Long
    Dim t As Long
    Dim m As Long
    Application.ScreenUpdating = False
    m = Range("C:D").Find(What:="*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
    Range("I5:M" & Rows.Count).Clear
    s = 4
    t = 4
    For r = 5 To m
        If Range("C" & r).Value <> "" And Range("D" & r).Value <> "" Then
            If Application.CountIfs(Range("C5:C" & m), Range("C" & r).Value, Range("D5:D" & m), "<>") = 1 Then
                s = s + 1
                Range("C" & r).Resize(1, 2).Copy Destination:=Range("I" & s)
            Else
                t = t + 1
                Range("C" & r).Resize(1, 2).Copy Destination:=Range("L" & t)
            End If
        End If
    Next r
    Application.ScreenUpdating = True
End Sub

View solution in original post