Solved

Extract 3 grids to excel in format

Posted on 2012-12-22
7
210 Views
Last Modified: 2012-12-27
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
0
Comment
Question by:Wilder1626
  • 4
  • 3
7 Comments
 
LVL 11

Author Comment

by:Wilder1626
ID: 38716173
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
 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 38716991
Hi,

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

Regards
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 38716997
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
PRTG Network Monitor: Intuitive Network Monitoring

Network Monitoring is essential to ensure that computer systems and network devices are running. Use PRTG to monitor LANs, servers, websites, applications and devices, bandwidth, virtual environments, remote systems, IoT, and many more. PRTG is easy to set up & use.

 
LVL 49

Expert Comment

by:Rgonzo1971
ID: 38717941
Hi,

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

Regards
0
 
LVL 11

Author Comment

by:Wilder1626
ID: 38718399
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
 
LVL 49

Accepted Solution

by:
Rgonzo1971 earned 500 total points
ID: 38720375
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
 
LVL 11

Author Closing Comment

by:Wilder1626
ID: 38723837
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

Featured Post

Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

There are many ways to remove duplicate entries in an SQL or Access database. Most make you temporarily insert an ID field, make a temp table and copy data back and forth, and/or are slow. Here is an easy way in VB6 using ADO to remove duplicate row…
Introduction While answering a recent question (http://www.experts-exchange.com/Q_27402310.html) in the VB classic zone, I wrote some VB code in the (Office) VBA environment, rather than fire up my older PC.  I didn't post completely correct code o…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…
This lesson covers basic error handling code in Microsoft Excel using VBA. This is the first lesson in a 3-part series that uses code to loop through an Excel spreadsheet in VBA and then fix errors, taking advantage of error handling code. This l…

773 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question