Do u think Can You Simplify My Code

Question

2.33/5 (2 votes)

See more:

Both has a column called : Location ID

These are the step I think the prog should do :

Promp user to select location of 2 file >> Read data from the user selected file >> Open pre-set Excel template paste item accordingly >> Save it!

Final Output: Same Location ID from both workbook in 1 sheet beside each other..

Possible? please guide me..newbie here..done my research :)
**i can post picture of the files but i don't think you can on here

Posted 20-Nov-11 19:01pm

Human2.0

Updated 28-Dec-11 21:10pm

v17

Add a Solution

Comments

Maciej Los 21-Nov-11 16:21pm

Everything is possible... but what have you done until now? Show the code!

Maciej Los 22-Nov-11 14:03pm

Please, always use "Improve question" link to add, change your question.

Maciej Los 22-Nov-11 14:54pm

Are the files "A" and "B" differ between themselfs?
I think you need to create a wizard.
Step 1: Select excel template,
Step 2: Select first merged file,
Step 3: Select second merged file.
Step 4: If the names and locations of files 1 and 2 are not equal, merge 2 files into template.
Am i right?

Human2.0 24-Nov-11 20:31pm

Thanks losmac for the edit on my question. I have updated the progressed code.
Not quite let me enlighten you,

total 5 button : Header Top , Header Bottom , Report Top , Report Bottom & Merge.
I have created a template for the final output.

Report top & Report bottom will be paste in a specified cell = copy & paste concept.
Quantity: Header files has standard set of rows each time.

Below that

the Report top & Report bottom will be "comb merge. The primary key would be "Location"

So same "Location" id from Report top & report bottom will be paste beside each other..process goes on depending how many quantity it has.

Quantity: report files has random quantity of rows.

Simplified steps:
1-user selects all 4 files.
2-user click merge
3-data are read and paste in the template file
4-user prompt to save.
-HAPPY ENDING-

4 solutions

Solution 4

AssasinCreedMother: that was not helpful:( but hey it's is defiantly possible, not that hard just that I'm not sure of the path. Keep following you might learn something as well

Posted 21-Nov-11 14:03pm

Human2.0

Comments

AssasinCreedMOTHER 21-Nov-11 22:53pm

sorry MOTHER getting old, i shall follow then !

Solution 1

The best idea is to create a List<integer>, then read the excel files one by one, inserting the Location Id's in for each file. Then you can do a sort on the List and insert the list into a new excel file.

Posted 20-Nov-11 19:32pm

Wayne Gaylard

Solution 3

You can't do that, impossible

Posted 20-Nov-11 20:53pm

AssasinCreedMOTHER

Comments

Maciej Los 21-Nov-11 16:24pm

Keep the Faith ;)

Add a Solution

Add your solution here

Treat my content as plain text, not as HTML

Preview 0

…

Existing Members

Sign in to your account

...or Join us

Download, Vote, Comment, Publish.

Your Email
Password
Forgot your password?

Your Email
This email is in use. Do you need your password?
Optional Password

I have read and agree to the Terms of Service and Privacy Policy
Please subscribe me to the CodeProject newsletters

When answering a question please:

Read the question carefully.
Understand that English isn't everyone's first language so be lenient of bad spelling and grammar.
If a question is poorly phrased then either ask for clarification, ignore it, or edit the question and fix the problem. Insults are not welcome.
Don't tell someone to read the manual. Chances are they have and don't get it. Provide an answer or move on to the next question.

Let's work to help developers, not make them feel stupid.

This content, along with any associated source code and files, is licensed under The Code Project Open License (CPOL)

Maciej Los · Accepted Answer · 2011-11-28T11:47:00

The code below shows how to create custom class to achieve what you want.
You need to create 2 files:
The content ofICombMerge.vb file (interface module):

VB

Public Interface ICombMerge

    Property TemplateFile() As String
    Property HeaderTop() As String
    Property HeaderBottom() As String
    Property ReportTop() As String
    Property ReportBottom() As String
    Property DestFile() As String
    Function GetMyFileName(Optional ByVal sTitle As String = "Select file...", Optional ByVal sInitialDir As String = "C:\") As String
    Function SaveAsFileName(Optional ByVal sTitle As String = "Save As ...", Optional ByVal sInitialDir As String = "C:\") As String
    Function MergeFiles() As Long

End Interface

The content of TCombMerge.vb file (class module):

VB

Public Class TCombMerge
    Implements ICombMerge

    Dim sHT As String = String.Empty 'header top
    Dim sHB As String = String.Empty 'header bottom
    Dim sRT As String = String.Empty 'report top
    Dim sRB As String = String.Empty 'report bottom
    Dim sTF As String = String.Empty 'template file
    Dim sDF As String = String.Empty 'destination file


    Public Sub New()
        'almost all variables already set
        sTF = Application.StartupPath & "\Templates\MergedReport.xls"
        sDF = Application.StartupPath & "\Output\" & DateTime.Today & "_MergedReport.xls"
    End Sub

    Public Sub New(ByVal _tf As String, ByVal _ht As String, ByVal _hb As String, ByVal _rt As String, ByVal _rb As String, ByVal _df As String)
        sTF = _tf
        sHT = _ht
        sHB = _hb
        sRT = _rt
        sRB = _rb
        sDF = _df
    End Sub

    Property TemplateFile() As String Implements ICombMerge.TemplateFile
        Get
            Return sTF
        End Get
        Set(ByVal _tf As String)
            sTF = _tf
        End Set
    End Property

    Property DestFile() As String Implements ICombMerge.DestFile
        Get
            Return sDF
        End Get
        Set(ByVal _df As String)
            sDF = _df
        End Set
    End Property


    Property HeaderTop() As String Implements ICombMerge.HeaderTop
        Get
            Return sHT
        End Get
        Set(ByVal _ht As String)
            sHT = _ht
        End Set
    End Property

    Property HeaderBottom() As String Implements ICombMerge.HeaderBottom
        Get
            Return sHB
        End Get
        Set(ByVal _hb As String)
            sHB = _hb
        End Set
    End Property

    Property ReportTop() As String Implements ICombMerge.ReportTop
        Get
            Return sRT
        End Get
        Set(ByVal _rt As String)
            sRT = _rt
        End Set
    End Property

    Property ReportBottom() As String Implements ICombMerge.ReportBottom
        Get
            Return sRB
        End Get
        Set(ByVal _rb As String)
            sRB = _rb
        End Set
    End Property


    Function GetMyFileName(Optional ByVal sTitle As String = "Select file...", Optional ByVal sInitialDir As String = "C:\") As String Implements ICombMerge.GetMyFileName
        Dim dlgOpen As OpenFileDialog = Nothing, dlgRes As DialogResult = DialogResult.Cancel
        Dim sFileName As String = String.Empty

        Try

            dlgOpen = New OpenFileDialog()
            With dlgOpen
                .Title = sTitle
                .InitialDirectory = sInitialDir
                .CheckFileExists = True
                .CheckPathExists = True
                .Filter = "Excel files (*.xls)|*.xls"
                .FilterIndex = 0
                .DefaultExt = "xls"
                .AddExtension = True
                .Multiselect = False
                dlgRes = .ShowDialog
            End With

            If dlgRes = DialogResult.Cancel Then Exit Try

            sFileName = dlgOpen.FileName


        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error...")
        Finally
            dlgOpen = Nothing
        End Try

        Return sFileName
    End Function


    Function SaveAsFileName(Optional ByVal sTitle As String = "Save As ...", Optional ByVal sInitialDir As String = "C:\") As String Implements ICombMerge.SaveAsFileName
        Dim dlgSave As SaveFileDialog = Nothing, dlgRes As DialogResult = DialogResult.Cancel
        Dim sFileName As String = String.Empty

        Try

            dlgSave = New SaveFileDialog()
            With dlgSave
                .Title = sTitle
                .InitialDirectory = sInitialDir
                .CheckFileExists = False
                .CheckPathExists = True
                .OverwritePrompt = True
                .Filter = "Excel files (*.xls)|*.xls"
                .FilterIndex = 0
                .DefaultExt = "xls"
                .AddExtension = True
                dlgRes = .ShowDialog
            End With

            If dlgRes = DialogResult.Cancel Then Exit Try

            sFileName = dlgSave.FileName


        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error...")
        Finally
            dlgSave = Nothing
        End Try

        Return sFileName
    End Function

    Function MergeFiles() As Long Implements ICombMerge.MergeFiles
        Dim retVal As Long = 0, i As Long = 0, j As Long = 0
        Dim sFiles() As String = Nothing, oExc As Object = Nothing
        Dim oWbkSrc As Object = Nothing, oWbkDst As Object = Nothing
        Dim oWshSrc As Object = Nothing, oWshDst As Object = Nothing

        'retval is used to return value of function
        '=0: OK
        '>0: Error occured

        Try

            If sHT = String.Empty Or sHB = String.Empty Or _
                sRT = String.Empty Or sRB = String.Empty Or sDF = String.Empty Then
                MsgBox("Select all files!" & vbCr & _
                        "Header: Top and Bottom," & vbCr & _
                        "Report: Top and Bottom," & vbCr & _
                        "Destination file!", MsgBoxStyle.Information, "Information...")
                Exit Try
            End If

            'change size of array
            ReDim Preserve sFiles(5)
            sFiles(0) = sHT
            sFiles(1) = sHB
            sFiles(2) = sRT
            sFiles(3) = sRB
            sFiles(4) = sTF
            sFiles(5) = sDF

            'compare names of files
            For i = sFiles.GetLowerBound(0) To sFiles.GetUpperBound(0) - 1
                For j = i + 1 To sFiles.GetUpperBound(0)
                    If sFiles(i).ToString = sFiles(j).ToString Then
                        MsgBox("'" & sFiles(i).ToString & "'" & vbCr & _
                                " is equal to: " & vbCr & _
                                "'" & sFiles(j).ToString & "'" & vbCr & vbCr & _
                                "Can't merge the same files!", MsgBoxStyle.Information, "Information")
                        Exit Try
                    End If
                Next
            Next

            'create instance of Excel application
            oExc = CreateObject("Excel.Application")
            'open template file (destination)
            oWbkDst = oExc.Workbooks.Open(sTF)
            'save as DestinationFileName...
            'Excel will prompt user if file already exists!
            oWbkDst.SaveAs(sDF)
            'set destination sheet
            oWshDst = oWbkDst.Worksheets(1) 'or oWbkDst.Worksheets("Name") 

            '----------------------- HEADER TOP -------------------------
            'open source file
            oWbkSrc = oExc.Workbooks.Open(sHT)
            'set source sheet
            oWshSrc = oWbkSrc.Worksheets(1)
            'copy data 
            For i = 1 To 12
                j = i + 1
                oWshSrc.Range("B" & i.ToString).Copy(oWshDst.Range("B" & j.ToString))
            Next
            oWbkSrc.Close(False) 'close without saving changes


            '----------------------- HEADER BOTTOM -------------------------
            oWbkSrc = oExc.Workbooks.Open(sHB)
            'set source sheet
            oWshSrc = oWbkSrc.Worksheets(1)
            'copy data 
            For i = 1 To 12
                j = i + 1
                oWshSrc.Range("B" & i.ToString).Copy(oWshDst.Range("C" & j.ToString))
            Next
            oWbkSrc.Close(False)

            '----------------------- REPORT TOP -------------------------
            oWbkSrc = oExc.Workbooks.Open(sRT)
            oWshSrc = oWbkSrc.Worksheets(1)
            i = 2
            'start copying data from row no. 16 in continous way (step by 1, not 2)
            Do
                j = i + 14
                oWshSrc.Range("A" & i.ToString & ":I" & i.ToString).Copy(oWshDst.Range("A" & j.ToString))
                'check the line below if you don't want to add comments
                oWshDst.Range("K" & j.ToString).Value = 1 'add comment (1 - report top) 
                i = i + 1
            Loop While oWshSrc.Range("A" & i.ToString).Value <> String.Empty
            oWbkSrc.Close(False)

            '----------------------- REPORT BOTTOM -------------------------
            oWbkSrc = oExc.Workbooks.Open(sRB)
            oWshSrc = oWbkSrc.Worksheets(1)
            i = 2
            'continue copying; if the last row in report-top is 60, start from 61
            Do
                j = j + 1
                oWshSrc.Range("A" & i.ToString & ":I" & i.ToString).Copy(oWshDst.Range("A" & j.ToString))
                'check the line below if you don't want to add comments
                oWshDst.Range("K" & j.ToString).Value = 2 'add comment (2 - report bottom)
                i = i + 1
            Loop While oWshSrc.Range("A" & i.ToString).Value <> String.Empty
            oWbkSrc.Close(False)

            'autofit columns
            oWshDst.Columns("A:K").EntireColumn.AutoFit()
            'save before sorting
            oWbkDst.Save()
            'sort data by Location and PartNumber
            'first select range of cells
            oWshDst.Range("A15:K" & j.ToString).Select()
            oWshDst.Range("A15:K" & j.ToString).Sort(Key1:=oWshDst.Range("A16"), Order1:=1, Key2:=oWshDst.Range("B16"), Order2:=1, _
                            Header:=1, OrderCustom:=1, MatchCase:=False, Orientation:=1, DataOption1:=0, DataOption2:=0)
            'add borders
            oWshDst.Range("A15:K" & j.ToString).Borders.LineStyle = 1
            'add color for headers = yellow
            oWshDst.Range("A15:K15").Interior.ColorIndex = 6

            'get total qty for each PartNumber => MAX(I16:I17)
            i = 16
            Do
                j = i + 1
                oWshDst.Range("J" & i.ToString & ":J" & j.ToString).Merge()
                'get total qty 
                oWshDst.Range("J" & i.ToString & ":J" & j.ToString).Formula = "=MAX(" & oWshDst.Range("I" & i.ToString & ":I" & j.ToString).Address & ")"
                'copy value of total qty
                oWshDst.Range("J" & i.ToString & ":J" & j.ToString).Copy()
                'paste value 
                oWshDst.Range("J" & i.ToString & ":J" & j.ToString).PasteSpecial(Paste:=-4163)
                i = i + 2
            Loop While oWshDst.Range("A" & i.ToString).Value <> String.Empty

            'save
            oWbkDst.Save()

        Catch ex As Exception
            MsgBox(ex.Message, MsgBoxStyle.Exclamation, "Error...")
            retVal = 1

        Finally
            sFiles = Nothing
            oWshSrc = Nothing
            oWshDst = Nothing
            oWbkSrc = Nothing
            oWbkDst = Nothing
            If Not oExc Is Nothing Then oExc.Visible = True
            oExc = Nothing

        End Try

        Return retVal
    End Function

    Protected Overrides Sub Finalize()
        MyBase.Finalize()
    End Sub
End Class

Now, you need to change code for your form (in my example: MainFrm):

VB

Public Class MainFrm

    Dim oCombMerge As ICombMerge = New TCombMerge()

    Private Sub MainFrm_FormClosing(ByVal sender As Object, ByVal e As System.Windows.Forms.FormClosingEventArgs) Handles Me.FormClosing
        oCombMerge = Nothing
    End Sub

    Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
        With Me
            .LblHT.Text = "(select file...)"
            .LblHB.Text = "(select file...)"
            .LblRT.Text = "(select file...)"
            .LblRB.Text = "(select file...)"
            .LblDstFile.Text = oCombMerge.DestFile
            .LblTF.Text = "Template: " & oCombMerge.TemplateFile
            .CmdHT.Text = "Top"
            .CmdHB.Text = "Bottom"
            .CmdRT.Text = "Top"
            .CmdRB.Text = "Bottom"
            .CmdDstFile.Text = "Save in..."
            .CmdMerge.Text = "Merge"
        End With
    End Sub

    Private Sub CmdHT_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdHT.Click
        oCombMerge.HeaderTop = oCombMerge.GetMyFileName("Select top for header file...", Application.StartupPath)
        Me.LblHT.Text = oCombMerge.HeaderTop
    End Sub

    Private Sub CmdHB_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdHB.Click
        oCombMerge.HeaderBottom = oCombMerge.GetMyFileName("Select bottom for header file...", Application.StartupPath)
        Me.LblHB.Text = oCombMerge.HeaderBottom
    End Sub

    Private Sub CmdRT_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdRT.Click
        oCombMerge.ReportTop = oCombMerge.GetMyFileName("Select top for report file...", Application.StartupPath)
        Me.LblRT.Text = oCombMerge.ReportTop
    End Sub

    Private Sub CmdRB_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdRB.Click
        oCombMerge.ReportBottom = oCombMerge.GetMyFileName("Select bottom for report file...", Application.StartupPath)
        Me.LblRB.Text = oCombMerge.ReportBottom
    End Sub

    Private Sub CmdMerge_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdMerge.Click
        oCombMerge.MergeFiles()
    End Sub

    Private Sub CmdDstFile_Click(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles CmdDstFile.Click
        oCombMerge.DestFile = oCombMerge.SaveAsFileName("Save into...", Application.StartupPath & "\Output\")
        Me.LblDstFile.Text = oCombMerge.DestFile
    End Sub
End Class

Here is the old source code ^. Compiled without errors. Not tested on the files.

Do u think Can You Simplify My Code

4 solutions

Solution 5

Solution 4

Solution 1

Solution 3

Add your solution here

Preview 0

Existing Members

...or Join us