Forum Discussion
Split data with the help of VBA
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.
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..
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
7 Replies
... 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<>"")) )- Thank you so much sir.
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 SubThe 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.
- Thank you so much sir.
