Extracting Data

  • Thread starter Thread starter Michael168
  • Start date Start date
M

Michael168

How can I extract row of data (A:D) and write them in other columns
(F:H,J:L,N:P,R:T) of the same row.
Next I want to count the group occurences times and write the report to
a new sheet.
I have more than two thousand rows of data.

e.g.

A B C D E F G H I J K L M N O P Q R S T
1 2 3 4 1 2 3 1 2 4 1 3 4 2 3 4
1 2 3 7 1 2 3 1 2 7 1 3 7 2 3 7
2 3 4 5 2 3 4 2 3 5 2 4 5 3 4 5

etc........
Group 123 = 2 times
Group 234 = 2 times
Rest of the groups = 1 time.

Any help is appreciated.
 
Here's how I would do it. The sheet with the 4-number
starter groups is called "Parse".
The sheet that counts the groups is called "GroupCount".

HTH,
Shockley

Sub Tester()

Sheets("GroupCount").Cells.ClearContents
Dim arr(1 To 3) As Double

With Sheets("Parse")
LastRow = .Cells(65536, 1).End(xlUp).Row
For i = 1 To LastRow
For j = 1 To 4
n = 0
For k = 1 To 4
If k <> j Then
n = n + 1
arr(n) = .Cells(i, k)
End If
Next k
LastCell = .Cells(i, 256).End(xlToLeft).Column

For n = 1 To 3
.Cells(i, LastCell + 1 + n) = arr(n)
sGroup = sGroup & arr(n)
Next n

With Sheets("GroupCount")
LastGroupRow = .Cells(65536, 1).End(xlUp).Row
If .Cells(1, 1) = Empty Then LastGroupRow = 0
.Cells(LastGroupRow + 1, 1) = sGroup
End With
sGroup = ""
Next j
Next i
End With

With Sheets("GroupCount")
.Activate
Columns(1).Sort _
Key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlNo
r = 1
LastGroup = ""
Do
If .Cells(r, 1) <> LastGroup Then
.Cells(r, 2) = Application.WorksheetFunction. _
CountIf(.Columns(1), .Cells(r, 1))
LastGroup = .Cells(r, 1)
Else: .Cells(r, 1) = Empty
End If
r = r + 1
Loop Until .Cells(r, 1) = Empty
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With

End Sub
 
Your module works great, except on the groupcount routine.

As stated it is a group count, so I prefer to group the identical
numbers in a single group and count it. Instead of the 3 or 6 groups
and count individually.

e.g.

123 = 1
132 = 2
213 = 1
231 = 1
312 = 2
321 = 2

Instead of above count and display, it will be much easier to look at a
single group like below

123 = 9 (Box)

Your modifications will be very helpful.

Thanks & Regards
Michael168
 
It's a little messy as I used a little space at the bottom of the "Parse"
worksheet to list the elements of "sGroup" for sorting by the Excel
worksheet function, but it's a whole lot easier (and runs faster) than
writing my own sort routine...

HTH,
Shockley


Sub Tester()

Sheets("GroupCount").Cells.ClearContents
Dim arr(1 To 3) As Double

With Sheets("Parse")
Set rngSort = Range(.Cells(65534, 1), .Cells(65536, 1))
.Activate
LastRow = .Cells(65536, 1).End(xlUp).Row
For i = 1 To LastRow
For j = 1 To 4
n = 0
For k = 1 To 4
If k <> j Then
n = n + 1
rngSort(n) = .Cells(i, k)
End If
Next k
rngSort.Sort _
Key1:=rngSort(1), _
Order1:=xlAscending, _
Header:=xlNo
LastCell = .Cells(i, 256).End(xlToLeft).Column

For n = 1 To 3
.Cells(i, LastCell + 1 + n) = rngSort(n)
sGroup = sGroup & rngSort(n)
Next n
rngSort.Value = Empty

With Sheets("GroupCount")
LastGroupRow = .Cells(65536, 1).End(xlUp).Row
If .Cells(1, 1) = Empty Then LastGroupRow = 0
.Cells(LastGroupRow + 1, 1) = sGroup
End With
sGroup = ""
Next j
Next i
End With

With Sheets("GroupCount")
.Activate
Columns(1).Sort _
Key1:=Range("A1"), _
Order1:=xlAscending, _
Header:=xlNo
r = 1
LastGroup = ""
Do
If .Cells(r, 1) <> LastGroup Then
.Cells(r, 2) = Application.WorksheetFunction. _
CountIf(.Columns(1), .Cells(r, 1))
LastGroup = .Cells(r, 1)
Else: .Cells(r, 1) = Empty
End If
r = r + 1
Loop Until .Cells(r, 1) = Empty
.Columns(1).SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With

End Sub
 
Back
Top