none
VB Macro Problem RRS feed

  • Question

  • I have a small problem with my VB Macro and cannot figure out how to correct it. Below is a copy of the code:

    Option Explicit
    
    Private Type JobHeader
      JHExpectedDel As String          'Col 1
      JHOrderCode As String           'Col 3
      JHDeliveryName As String         'Col 5
      JHDeliveryAddress1 As String       'Col 6
      JHDeliveryAddress2 As String       'Col 7
      JHDeliveryAddress3 As String       'Col 8
      JHDeliveryAddress4 As String       'Col 9
      JHDeliveryAddress5 As String       'Col 10
      JHPostcode As String           'Col 11
      JHDeliveryInstructions1 As String     'Col 12
      JHProductCode As String          'Col 13
    End Type
    
    Private Type JobDetails
      JDExpectedDel As String
      JDOrderCode As String
      JDDeliveryName As String
      JDDeliveryAddress1 As String
      JDDeliveryAddress2 As String
      JDDeliveryAddress3 As String
      JDDeliveryAddress4 As String
      JDDeliveryAddress5 As String
      JDPostcode As String
      JDDeliveryInstructions1 As String
      JDProductCode As String
      JDQuantity As String
      JDPickingInstructions1 As String
      JDReference2 As String
    End Type
    
    Dim JobHeader As JobHeader
    Dim JobDetails As JobDetails
    Dim FileNameStr As String
    Dim RowStart As Integer
    Dim MsgResponse As Integer
    Dim JobNumber As Long
    
    Sub StirlingExport()
      'Message Box to confirm you want to export the jobs to Stirling
      MsgResponse = MsgBox("NOTICE: This will now create a Stirling Import File!!" & vbCrLf & "Confirm Job(s) Export To Stirling?", _
      vbInformation + vbYesNo, "Export Order")
      
      'Sets the CSV filename to be BoostStirlingExport and then the Date
      If MsgResponse = 6 Then
        FileNameStr = "C:\Users\kevin.crookes\Desktop\BoostStirlingExport " & Format(Date, "dd-mm-yyyy") & ".csv"
        Call WriteFile
      Else
        MsgResponse = MsgBox("Check Job Spreadsheet File", vbCritical)
      End If
    
    End Sub
    
    Sub WriteFile()
      
      'Sets the row start point
      RowStart = 3
    
      Open FileNameStr For Output As #1
      
      JobHeader.JHExpectedDel = "DeliveryDate"                 'Col 1
      JobHeader.JHOrderCode = "OrderNumber"                  'Col 3
      JobHeader.JHDeliveryName = "DeliveryAddressName"             'Col 5
      JobHeader.JHDeliveryAddress1 = "DeliveryAddress1"            'Col 6
      JobHeader.JHDeliveryAddress2 = "DeliveryAddress2"            'Col 7
      JobHeader.JHDeliveryAddress3 = "DeliveryAddress3"            'Col 8
      JobHeader.JHDeliveryAddress4 = "DeliveryAddress4"            'Col 9
      JobHeader.JHDeliveryAddress5 = "DeliveryAddress5"            'Col 10
      JobHeader.JHPostcode = "DeliveryPostcode"                'Col 11
      JobHeader.JHDeliveryInstructions1 = "DeliveryNotes"           'Col 12
      JobHeader.JHProductCode = "GoodsDescription"               'Col 13
      
      Write #1, JobHeader.JHExpectedDel, JobHeader.JHOrderCode, JobHeader.JHDeliveryName, _
        JobHeader.JHDeliveryAddress1, JobHeader.JHDeliveryAddress2, JobHeader.JHDeliveryAddress3, _
        JobHeader.JHDeliveryAddress4, JobHeader.JHDeliveryAddress5, JobHeader.JHPostcode, JobHeader.JHDeliveryInstructions1, _
        JobHeader.JHProductCode
      
      
      Do
        'Checks to see if the first field is empty, if so closes the file
        If Cells(RowStart, 1).Value = "" Then
          GoTo CloseFile
        Else
          Call ProcessJobs
          Call WritesJobs
        End If
      Loop
      
    CloseFile:
      Close #1
    
    End Sub
    
    
    Sub ProcessJobs()
        JobDetails.JDExpectedDel = Format(Cells(RowStart, 1).Value, "DD-MMMM-YYYY") 'Col 1
        JobDetails.JDOrderCode = Cells(RowStart, 3).Value                 'Col 3
        JobDetails.JDDeliveryName = Cells(RowStart, 5).Value               'Col 5
        JobDetails.JDDeliveryAddress1 = Cells(RowStart, 6).Value             'Col 6
        JobDetails.JDDeliveryAddress2 = Cells(RowStart, 7).Value             'Col 7
        JobDetails.JDDeliveryAddress3 = Cells(RowStart, 8).Value             'Col 8
        JobDetails.JDDeliveryAddress4 = Cells(RowStart, 9).Value             'Col 9
        JobDetails.JDDeliveryAddress5 = Cells(RowStart, 10).Value             'Col 10
        JobDetails.JDPostcode = Cells(RowStart, 11).Value                 'Col 11
        JobDetails.JDDeliveryInstructions1 = Cells(RowStart, 12).Value          'Col 12
        JobDetails.JDProductCode = Cells(RowStart, 13).Value               'Col 13
        JobDetails.JDQuantity = Cells(RowStart, 14).Value                 'Col 14
        JobDetails.JDPickingInstructions1 = Cells(RowStart, 15).Value           'Col 15
        JobDetails.JDReference2 = Cells(RowStart, 4).Value                'Col 4
        JobDetails.JDProductCode = JobDetails.JDProductCode + ": " + JobDetails.JDQuantity + Chr(13)
        
        If JobDetails.JDReference2 <> "" Then JobDetails.JDDeliveryInstructions1 = JobDetails.JDDeliveryInstructions1 + " BK Ref:" + JobDetails.JDReference2
        If JobDetails.JDPickingInstructions1 <> "" Then JobDetails.JDDeliveryInstructions1 = JobDetails.JDDeliveryInstructions1 + " " + JobDetails.JDPickingInstructions1
    End Sub
    
    Sub WritesJobs()
    
      If Cells(RowStart, 3).Value = JobNumber Then
        RowStart = RowStart + 1
      Else
        JobNumber = Val(Cells(RowStart, 3).Value)
        Write #1, JobDetails.JDExpectedDel, JobDetails.JDOrderCode, JobDetails.JDDeliveryName, _
        JobDetails.JDDeliveryAddress1, JobDetails.JDDeliveryAddress2, JobDetails.JDDeliveryAddress3, _
        JobDetails.JDDeliveryAddress4, JobDetails.JDDeliveryAddress5, JobDetails.JDPostcode, JobDetails.JDDeliveryInstructions1, _
        JobDetails.JDProductCode
      End If
      
    End Sub
    

    The macro goes through the spreadsheet and extracts each unique order and puts this into a CSV file.

    Spreadsheet Example (There are more columns, but I have shorten this for the example).

    OrderNum DeliveryAddress LineNum ProductCode Quantity

    55            Address1           1            5552            150
    55            Address1           2            5555            240
    55            Address1           3            5557            147

    87            Address22         1            774S            50
    87            Address22         2            33S              98

    45            Address13         1            54S              51

     

    CSV File:

    "55", "Address1"
    "87", "Address22"
    "45", "Address13"

    This is fine because all I needed was the Order Number, Delivery Details etc up until now. What I need to do is to concatenate the ProductCode and Quantity into one field in the CSV file.

    CSV File Example:

    "55", "Address1", "Product:5552 Quantity:150 Product:5555 Quantity:240 Product:5557 Quantity:147"
    "87", "Address22", "Product:774S Quantity:50 Product:33S Quantity:98"
    "45", "Address13", "Product:54S Quantity:51"

    Any ideas how this can be done??

    Thanks

    • Moved by William Zhou CHN Thursday, June 30, 2011 5:28 AM Coding for Developer (From:Excel IT Pro Discussions)
    Wednesday, June 29, 2011 9:53 AM

All replies

  • Could you please provide information about what this has to do with Office, and which version of Office? I'm not seeing anything Office-related...
    Cindy Meister, VSTO/Word MVP
    Thursday, June 30, 2011 12:25 PM
    Moderator