Group by string value and perform operation

[Adonaioc]

I have a sheet that opens about 450 files and extracts data into a sheet. all of that works great, but I want to do some mass formatting and then be able to select all rows with the same value in col DY and import them to a new file named the value in column DY. There are about 450 values in column DY and I dont know how to tell it to grab the first set\perform operation\grab the second set\perform operation... I am stuck, any help would be appreciated.

Column DY would look something like this

L007-2003-00.cay
L007-2003-00.cay
L007-2003-01.cay
L007-2179-00.cay
L007-2179-00.cay
L007-2179-00.cay
L007-2179-00.cay
L007-2180-00.cay
L007-2180-00.cay
L007-2180-00.cay
L007-2181-00.cay
L007-2181-00.cay
L007-2181-00.cay
L007-2183-00.cay
L007-2183-00.cay
L007-2183-00.cay
L007-2185-00.cay

I hope that makes sence.

[nst1107]

See if this helps.[vba]Option Explicit
Sub SortAndGetGroup()
Dim FirstValue As String
Dim StartRow As Long, EndRow As Long
'If not already sorted, sort.
Sheet1.Columns("AY").Sort Key1:=[DY1], Order1:=xlAscending
If [DY1] = vbNullString Then Exit Sub
FirstValue = [DY1]
StartRow = 1
EndRow = 2
Do
If Cells(EndRow, "DY") = vbNullString Then
PerformAction StartRow, EndRow - 1
Exit Sub
End If
If Cells(EndRow, "DY") <> FirstValue Then
PerformAction StartRow, EndRow - 1
FirstValue = Cells(EndRow, "DY")
StartRow = EndRow
End If
EndRow = EndRow + 1
Loop
End Sub
Sub PerformAction(StartRow As Long, EndRow As Long)
Debug.Print "Perfomed action on group: " & Sheet1.Cells(StartRow, "DY")
End Sub
[/vba]

[Sagy]

You can create a collection in which you can keep the values from column DY using the value as a key. If the add is successful this is the first time you encountered the value and you should do the processing. If the add failed, the value has already been seen and there is nothing for you to do.

Make sure you use trap the error since trying to add an item with a duplicate key to a collection will throw an error.

[Kenneth Hobs]

Not sure what you mean by import. You can export from your master workbook to new workbooks, existing workbooks or to new text files or append to existing text files. So, tell us in more detail what you want to do.

[Adonaioc]

This is what Ive got so far, im having trouble understanding the logic behind nates code, how can I then perform the operation on those rows. Im not sure how to call them.

[VBA]Sub SortAndGetGroup()
Dim FirstValue As String
Dim StartRow As Long, EndRow As Long
'If not already sorted, sort.
Library.Columns("AY").Sort Key1:=[DY1], Order1:=xlAscending
Set m__cayObject = CreateObject("Cayman.Wirelist")
Set m__cayObject = GetObject(, "Cayman.Wirelist")
If [DY1] = vbNullString Then Exit Sub

FirstValue = [DY1]
StartRow = 1
EndRow = 2
Do
If Cells(EndRow, "DY") = vbNullString Then
PerformAction StartRow, EndRow - 1
Exit Sub
End If
If Cells(EndRow, "DY") <> FirstValue Then
PerformAction StartRow, EndRow - 1
FirstValue = Cells(EndRow, "DY")
StartRow = EndRow
End If
EndRow = EndRow + 1
Loop
End Sub
Sub PerformAction(StartRow As Long, EndRow As Long)

Dim antwort
Dim Quant As Integer
Quant = 0
Dim Answer As Integer
Dim Row, Col As Integer
Dim StringTemp As String
Dim LongTemp As Long
Dim DoubleTemp As Double
Dim IntegerTemp As Integer

'Create a new wire list
m__cayObject.sListNewWirelist

'Sheets("PartsData").Select
Sheets("Library").Select


Row = 2 'in row 1 there are the headlines
Col = 1
While ActiveSheet.Cells(Row, Col).Value <> ""
'Import all data in Cayman
'Create new wire
'Answer = m__cayObject.sListInsertWire

'Checked
IntegerTemp = ActiveSheet.Cells(Row, Col).Value
Answer = 0
Col = Col + 1

'Name
StringTemp = ActiveSheet.Cells(Row, Col).Value
Answer = m__cayObject.sWireSetName(StringTemp)
Col = Col

'Save As
StringTemp = Library.Cells(StartRow, "DY")
Answer = m__cayObject.sListSaveAsWirelist(StringTemp)
Col = Col + 1

'Total
LongTemp = ActiveSheet.Cells(Row, Col).Value
Answer = 1
Col = Col + 1

'Batch
LongTemp = ActiveSheet.Cells(Row, Col).Value
Answer = 0
Col = Col + 1

'Length
DoubleTemp = ActiveSheet.Cells(Row, Col).Value
Answer = m__cayObject.sWireSetLength(DoubleTemp * 25.4, 0)
Col = Col + 1

'Raw Material
StringTemp = ActiveSheet.Cells(Row, Col).Value
Answer = m__cayObject.sWireSetRawMaterial(StringTemp)
Col = Col + 1

'Processing
StringTemp = ActiveSheet.Cells(Row, Col).Value
Answer = m__cayObject.sWireSetProcessing(StringTemp)
Col = Col + 1

'Comments
StringTemp = ActiveSheet.Cells(Row, Col).Value
Answer = m__cayObject.sWireSetComment(StringTemp)
Col = Col + 1

'Steps
Dim StepNr As Integer
For StepNr = 1 To 2 * conMaxSteps
If ActiveSheet.Cells(Row, Col).Value <> "" Then
Dim Dir As Integer, Layer As Integer, Mode As Integer, Step As Integer, FirstBranch As Integer, LastBranch As Integer, Recut As Integer
Dim Position As Double, Length As Double
If StepNr > conMaxSteps Then
Dir = 0 'Left
Else
Dir = 1 'Right
End If
Layer = ActiveSheet.Cells(Row, Col).Value
Col = Col + 1
'Mode = ActiveSheet.Cells(Row, Col).Value
'Col = Col + 1
Position = ActiveSheet.Cells(Row, Col).Value * 25.4
Col = Col + 1
Length = ActiveSheet.Cells(Row, Col).Value * 25.4
Col = Col + 1
FirstBranch = -1
LastBranch = -1
Recut = 0
Answer = m__cayObject.sWireInsertOpElement(Dir, Layer, Mode, Step, Position, Length, FirstBranch, LastBranch, Recut, 0)
Else
Col = Col + conFieldsPerStep
End If
Next StepNr

'Increment Rows
Row = Row + 1
Col = 1
Wend

'm__cayObject.sListSaveAsWirelist (Library.Cells(StartRow, "DY"))
m__cayObject.sListSaveWirelist

Debug.Print "Perfomed action on group: " & Library.Cells(StartRow, "DY")
End Sub[/VBA]

[Adonaioc]

I am wanting to select all rows with a like value in column DY then export them to a different program, then loop to the next set of like values in column DY

[nst1107]

At the line [VBA]PerformAction StartRow, EndRow - 1[/VBA]The sub "PerformAction" is called, with StartRow (beginning row of the group) and EndRow (last row of the group) passed as arguments. So, in the "PerformAction" sub, simply refer to StartRow and EndRow when you need to get the limits of the group you're working with.

[MaximS]

you might try that to get the unique values from your range and then perform desired operations, see below:


[VBA]
Private Sub Data_Exporter()

Dim LastRow As Long
LastRow = Range("A65536").End(xlUp).Row

Dim Category As Variant
Set Range1 = Range("A2:A" & LastRow)
Category = UniqueItems(Range1, False)

For i = 1 To UBound(Category)

'Add your sorting, copying code

Next i

End Sub

Function UniqueItems(ArrayIn, Optional Count As Variant) As Variant
' Accepts an array or range as input
' If Count = True or is missing, the function returns the number
' of unique elements
' If Count = False, the function returns a variant array of unique
' elements

Dim Unique() As Variant ' array that holds the unique items
Dim Element As Variant
Dim i As Integer
Dim FoundMatch As Boolean

' If 2nd argument is missing, assign default value
If IsMissing(Count) Then Count = True

' Counter for number of unique elements
NumUnique = 0

' Loop thru the input array
For Each Element In ArrayIn
FoundMatch = False
' Has item been added yet?
For i = 1 To NumUnique
If Element = Unique(i) Then
FoundMatch = True
GoTo AddItem '(Exit For-Next loop)
End If
Next i

AddItem:
' If not in list, add the item to unique list
If Not FoundMatch Then
NumUnique = NumUnique + 1
ReDim Preserve Unique(NumUnique)
Unique(NumUnique) = Element
End If

Next Element

' Assign a value to the function
If Count Then UniqueItems = NumUnique Else UniqueItems = Unique
End Function
[/VBA]