Results 1 to 20 of 117

Thread: Convert Many Invoice Formats to a Standard Format

Hybrid View

Previous Post Previous Post   Next Post Next Post
  1. #1
    Paul

    I have attached the raw data and also the output the macro creates.

    Thanks
    Attached Files Attached Files

  2. #2
    VBAX Sage
    Joined
    Apr 2007
    Location
    United States
    Posts
    8,887
    Location
    Quote Originally Posted by joeny0706 View Post
    Paul

    I have attached the raw data and also the output the macro creates.

    Thanks
    OK, see if this works for you

    The CSV file must be open in Excel as a workbook. It should be the only CSV open

    The macro just reformats the CSV worksheet in the CSV workbook without saving it anywhere

    The Rep is copied to the credit lines

    Option Explicit
    
    
    Sub FixCSV()
        Dim wbCSV As Workbook, wb As Workbook
        Dim wsCSV As Worksheet
        Dim rCSV As Range, rCSV1 As Range
        Dim i As Long, j As Long
        
        'find open WB ending in CSV
        For Each wb In Workbooks
            If Right(wb.FullName, 3) = "CSV" Then
                Set wbCSV = wb
                Exit For
            End If
        Next
        
        If wbCSV Is Nothing Then
            Call MsgBox("There is no CSV file open in Excel", vbExclamation + vbOKOnly, "Fix CSV")
            Exit Sub
        End If
        
        Application.ScreenUpdating = False
        
        Set wsCSV = wbCSV.Worksheets(1)
        
        With wsCSV      '   Guessing
            .Cells(1, 1).Value = "Date"
            .Cells(1, 2).Value = "Invoice"
            .Cells(1, 3).Value = "Store"
            .Cells(1, 4).Value = "Product"
            .Cells(1, 5).Value = "Qty"
            .Cells(1, 6).Value = "Cost"
            .Cells(1, 7).Value = "InvCred"
            .Cells(1, 8).Value = "Something"
            .Cells(1, 9).Value = "Counter1"
            .Cells(1, 10).Value = "Counter2"
            .Cells(1, 11).Value = "Counter3"
            .Cells(1, 12).Value = "Representitive"
            
        
            Set rCSV = .Cells(1, 1).CurrentRegion
            
            'save original order
            For i = 1 To rCSV.Rows.Count
                .Cells(i, 13).Value = i
            Next i
            
            Set rCSV = .Cells(1, 1).CurrentRegion
            Set rCSV1 = rCSV.Cells(2, 1).Resize(rCSV.Rows.Count - 1, rCSV.Columns.Count)
            
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=rCSV1.Columns(1), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SortFields.Add Key:=rCSV1.Columns(3), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
                .SortFields.Add Key:=rCSV1.Columns(7), SortOn:=xlSortOnValues, Order:=xlDescending, DataOption:=xlSortNormal
            
                .SetRange rCSV
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        End With
        
        With rCSV
            For i = 2 To .Rows.Count
                If .Cells(i, 7).Value = "C" Then    '   CREDIT?
                    j = i
                    'same store and same date
                    Do While (.Cells(j, 3).Value = .Cells(i - 1, 3).Value) And _
                        (.Cells(j, 1).Value = .Cells(i - 1, 1).Value)
                        .Cells(j, 2).Value = "'9" & .Cells(i - 1, 2).Value      '  add leading 9
                        .Cells(j, 12).Value = .Cells(i - 1, 12).Value           '  add rep
                        .Cells(j, 7).Value = "-C"                               '  add marker
                        j = j + 1
                    Loop
                End If
            Next i
        
            Call .Columns(7).Replace("-C", "C", xlWhole)
        End With
        
        'back to original sort order
        With wsCSV
            With .Sort
                .SortFields.Clear
                .SortFields.Add Key:=rCSV1.Columns(13), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
            
                .SetRange rCSV
                .Header = xlYes
                .MatchCase = False
                .Orientation = xlTopToBottom
                .SortMethod = xlPinYin
                .Apply
            End With
        
            'get rid of order column
            .Columns(13).Delete
        
            'row 1 was originally blank
            .Rows(1).Resize(1, 12).ClearContents
        End With
        
        Application.ScreenUpdating = False
        
        MsgBox "CSV file " & wbCSV.FullName & " reformatted"
    End Sub
    Attached Files Attached Files
    ---------------------------------------------------------------------------------------------------------------------

    Paul


    Remember: Tell us WHAT you want to do, not HOW you think you want to do it

    1. Use [CODE] ....[/CODE ] Tags for readability
    [CODE]PasteYourCodeHere[/CODE ] -- (or paste your code, select it, click [#] button)
    2. Upload an example
    Go Advanced / Attachments - Manage Attachments / Add Files / Select Files / Select the file(s) / Upload Files / Done
    3. Mark the thread as [Solved] when you have an answer
    Thread Tools (on the top right corner, above the first message)
    4. Read the Forum FAQ, especially the part about cross-posting in other forums
    http://www.vbaexpress.com/forum/faq...._new_faq_item3

  3. #3
    Paul


    Looks good. Thanks

    After I run the macro I need to save the file, close it and open it again. If I dont do that and I look all the credit numbers have a ' in front of the 9. But once I close it and open it again it is gone. Weird.
    Attached Files Attached Files

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •