Do more with
Dim Doors As New Collection
Dim Door_Entry As String
Dim Order_Group() As String
Dim P_Carrier() As String
Dim Carrier() As String
Private Sub Form_Load()
With MSHFlexGrid1
.FixedCols = 0
.Cols = 2
.Rows = 1
.AddItem "A" & vbTab & "test1", 1
.AddItem "A" & vbTab & "test2", 2
.AddItem "A" & vbTab & "test3", 3
.AddItem "B" & vbTab & "test4", 4
.AddItem "C" & vbTab & "test5", 5
.AddItem "C" & vbTab & "test6", 6
.AddItem "C" & vbTab & "test7", 7
.FixedRows = 1
.TextMatrix(0, 0) = "Door"
.TextMatrix(0, 1) = "Order Group"
End With
With MSHFlexGrid2
.FixedCols = 0
.Cols = 2
.Rows = 1
.AddItem "A" & vbTab & "test8", 1
.AddItem "B" & vbTab & "test9", 2
.AddItem "B" & vbTab & "test10", 3
.AddItem "B" & vbTab & "test11", 4
.AddItem "B" & vbTab & "test12", 5
.AddItem "C" & vbTab & "test13", 6
.AddItem "C" & vbTab & "test14", 7
.FixedRows = 1
.TextMatrix(0, 0) = "Door"
.TextMatrix(0, 1) = "P Carrier"
End With
With MSHFlexGrid3
.FixedCols = 0
.Cols = 2
.Rows = 1
.AddItem "A" & vbTab & "test15", 1
.AddItem "A" & vbTab & "test16", 2
.AddItem "A" & vbTab & "test17", 3
.AddItem "A" & vbTab & "test18", 4
.AddItem "B" & vbTab & "test19", 5
.AddItem "C" & vbTab & "test20", 6
.AddItem "C" & vbTab & "test21", 7
.FixedRows = 1
.TextMatrix(0, 0) = "Door"
.TextMatrix(0, 1) = "Carrier"
End With
With MSHFlexGrid4
.FixedCols = 0
.Cols = 4
.FixedRows = 1
.TextMatrix(0, 0) = "Door"
.TextMatrix(0, 1) = "Order Group"
.TextMatrix(0, 2) = "P Carrier"
.TextMatrix(0, 3) = "Carrier"
End With
End Sub
Private Sub Command1_Click()
Dim Door_Found As Boolean
Dim i As Integer
'get all distinct Doors
For i = 1 To MSHFlexGrid1.Rows - 1
If MSHFlexGrid1.TextMatrix(i, 0) <> "" Then
Door_Found = False
For Each Item In Doors
If Item = MSHFlexGrid1.TextMatrix(i, 0) Then
Door_Found = True
Exit For
End If
Next
If Door_Found = False Then
Doors.Add MSHFlexGrid1.TextMatrix(i, 0)
End If
End If
Next i
For Each Item In Doors
'check Order Group Tests
ReDim Order_Group(0 To 0)
For i = 1 To MSHFlexGrid1.Rows - 1
If MSHFlexGrid1.TextMatrix(i, 0) <> "" Then
If Item = MSHFlexGrid1.TextMatrix(i, 0) Then
Order_Group(UBound(Order_Group())) = MSHFlexGrid1.TextMatrix(i, 1)
ReDim Preserve Order_Group(0 To UBound(Order_Group()) + 1)
End If
End If
Next i
'check P Carrier Test
ReDim P_Carrier(0 To 0)
For i = 1 To MSHFlexGrid2.Rows - 1
If MSHFlexGrid2.TextMatrix(i, 0) <> "" Then
If Item = MSHFlexGrid2.TextMatrix(i, 0) Then
P_Carrier(UBound(P_Carrier())) = MSHFlexGrid2.TextMatrix(i, 1)
ReDim Preserve P_Carrier(0 To UBound(P_Carrier()) + 1)
End If
End If
Next i
'check Carrier Test
ReDim Carrier(0 To 0)
For i = 1 To MSHFlexGrid3.Rows - 1
If MSHFlexGrid3.TextMatrix(i, 0) <> "" Then
If Item = MSHFlexGrid3.TextMatrix(i, 0) Then
Carrier(UBound(Carrier())) = MSHFlexGrid3.TextMatrix(i, 1)
ReDim Preserve Carrier(0 To UBound(Carrier()) + 1)
End If
End If
Next i
j = 0
Door_Entry = ""
Do While j < UBound(Order_Group()) Or _
j < UBound(P_Carrier()) Or _
j < UBound(Carrier())
Door_Entry = Item
If j < UBound(Order_Group()) Then
Door_Entry = Door_Entry & vbTab & Order_Group(j)
Else
Door_Entry = Door_Entry & vbTab & " "
End If
If j < UBound(P_Carrier()) Then
Door_Entry = Door_Entry & vbTab & P_Carrier(j)
Else
Door_Entry = Door_Entry & vbTab & " "
End If
If j < UBound(Carrier()) Then
Door_Entry = Door_Entry & vbTab & Carrier(j)
Else
Door_Entry = Door_Entry & vbTab & " "
End If
j = j + 1
MSHFlexGrid4.AddItem Door_Entry
Loop
MSHFlexGrid4.AddItem ""
Next
End Sub
Private Sub Command2_Click()
Dim xlObject As Excel.Application
Dim xlWB As Excel.Workbook
Set xlObject = New Excel.Application
Set xlWB = xlObject.Workbooks.Add
Clipboard.Clear
With MSHFlexGrid4
.Col = 0
.Row = 0
.ColSel = .Cols - 1
.RowSel = .Rows - 1
Clipboard.SetText .Clip
End With
With xlObject.ActiveWorkbook.ActiveSheet
.Range("A1").Select 'Set insertion point where ever you want
.Paste
End With
xlObject.Visible = True
End Sub
Premium Content
You need an Expert Office subscription to comment.Start Free Trial