Extract 3 grids to excel in format

Hello all

I have these 3 grids where i would like to extract the data to excel following this process.

In column 0 you have the door letter.

In column 1 from each grid have order groups that link to the door, the P Carrier that link to the door and the Carrier that link to the door.

I would like to extract to excel based on the door letter.

How can i do that?

Name of grids:
MSHFlexgrid1
MSHFlexgrid2
MSHFlexgrid3

Grid look like:
grid

Excel extract result would be like:
 excel result
Thanks again for your help
LVL 11
Wilder1626Asked:
Who is Participating?
 
Rgonzo1971Connect With a Mentor Commented:
Hi,

Here is my code, with the file to test it

Sub DoTheJob()


Dim aryFlexGrid1 As Variant
Dim aryFlexGrid2 As Variant
Dim aryFlexGrid3 As Variant
Dim aryDoors As Variant

aryFlexGrid1 = Range("OrderGroup")
aryFlexGrid2 = Range("PCarrier")
aryFlexGrid3 = Range("carrier")
aryDoors = Range("OrderGroup").Resize(Range("OrderGroup").Rows.Count, 1)

Dim dictDoors As Scripting.Dictionary
Set dictDoors = New Scripting.Dictionary
For Each door In aryDoors
    If Not dictDoors.Exists(door) Then dictDoors.Add door, door
Next


Set rngActual = Range("A6")
rngActual.Activate

IdxFlexGrid1Line = 1
IdxFlexGrid2Line = 1
IdxFlexGrid3Line = 1

For Each DoorItem In dictDoors
    rngActual.Value = DoorItem
    myFormatCell rngActual
    IdxDoorLine = 0
    Do While aryFlexGrid1(IdxFlexGrid1Line, 1) = DoorItem
        Set rngTemp = rngActual.Offset(IdxDoorLine, 1)
        rngTemp.Value = aryFlexGrid1(IdxFlexGrid1Line, 2)
        myFormatCell rngTemp
        IdxDoorLine = IdxDoorLine + 1
        IdxFlexGrid1Line = IdxFlexGrid1Line + 1
        If IdxFlexGrid1Line > UBound(aryFlexGrid1) Then Exit Do
    Loop
    IdxDoorLine = 0
    Do While aryFlexGrid2(IdxFlexGrid2Line, 1) = DoorItem
        Set rngTemp = rngActual.Offset(IdxDoorLine, 2)
        rngTemp.Value = aryFlexGrid2(IdxFlexGrid2Line, 2)
        myFormatCell rngTemp
        IdxDoorLine = IdxDoorLine + 1
        IdxFlexGrid2Line = IdxFlexGrid2Line + 1
        If IdxFlexGrid2Line > UBound(aryFlexGrid2) Then Exit Do
    Loop
    IdxDoorLine = 0
    Do While aryFlexGrid3(IdxFlexGrid3Line, 1) = DoorItem
       Set rngTemp = rngActual.Offset(IdxDoorLine, 3)
        rngTemp.Value = aryFlexGrid3(IdxFlexGrid3Line, 2)
        myFormatCell rngTemp
        IdxDoorLine = IdxDoorLine + 1
        IdxFlexGrid3Line = IdxFlexGrid3Line + 1
        If IdxFlexGrid3Line > UBound(aryFlexGrid3) Then Exit Do
    Loop
    intRegionRows = rngActual.CurrentRegion.Rows.Count
    Set rngActual = rngActual.Offset(intRegionRows + 1)
    
Next

Range("A5").Formula = "Door"
Range("B5").Formula = "Order Group"
Range("C5").Formula = "P Carrier"
Range("D5").Formula = "carrier"
Range("A15:D15").Select
With Range("A5:D5")
    With .Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorDark1
        .TintAndShade = -0.349986266670736
        .PatternTintAndShade = 0
    End With
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
End With



End Sub

Sub myFormatCell(ByVal r As Range)
With r
    With .Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With .Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
End With

End Sub

Open in new window


Regards
Doors-Carrriers.xlsm
0
 
Wilder1626Author Commented:
If this is impossible, is it possible to extract the 3 grid in the same excel file but in different spreadsheet?

The sheet could be named by the MSHFlexgrid name.

Thanks again for your help
0
 
Rgonzo1971Commented:
Hi,

Where is your problem: In getting the data from flexgrid or in organizing it in excel?

Regards
0
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
Wilder1626Author Commented:
My problem is to organize in Excel and also transferring the data in excel the right way.

Is that possible to do?

How can i do that?

Thanks a lot for your help.
0
 
Rgonzo1971Commented:
Hi,

2 questions:
Is every door ever to be there(are all the doors in every flexgrid)?
Is your data already sorted?

Regards
0
 
Wilder1626Author Commented:
Hi

Question 1:
All doors are in every MSHFlexgrid.

Question 2:
Yes all MSHFlexgrid are sorted on column 0 (Door column value)


Should i had a 4th grid with all door name only?

Thanks again
0
 
Wilder1626Author Commented:
Hi Rgonzo1971

I'm seeing this being a excel macro but i would like to do this in VB6

Since i do like the excel macro, here's the point and i will re open a new topic.

Thanks
0
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.