Wednesday, August 14, 2013

Dynamics GP - Macro to convert Tab-delimited AP export to Useful Excel

Sub Macro1()
' This will only work for US formatted dates, default AP TB
' Export the APTB as a tab delimited file
' Import the data into a Macro Enabled Excel Sheet
' Copy and paste this code into a VB Module, and run it against your sheet
' It will reformat the data to a more useful state


'
    Dim a, b, TheVend, LineCheck3, LineCheck1, LineCheck7, LC2, LC3, LC5, LC6, LC8, LC15
    a = 0
' this controls how many columns to the right it looks for the outstanding amounts
    b = 6
   
     
'Insert index
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
   

'Insert vendor column
    Columns("A:A").Select
    Selection.Insert Shift:=xlToRight, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
   
    Do Until ActiveCell.Offset(a, 2).Value = "Vendor Totals:"
    ActiveCell.Offset(a, 1).Value = a
    LC2 = ActiveCell.Offset(a, 2).Value
    LC3 = ActiveCell.Offset(a, 3).Value
    LineCheck3 = ActiveCell.Offset(a, 4).Value
    LineCheck1 = ActiveCell.Offset(a, 2).Value
    LineCheck7 = ActiveCell.Offset(a, 7).Value
    LC5 = ActiveCell.Offset(a, 5).Value
    LC6 = ActiveCell.Offset(a, 6).Value
    LC8 = ActiveCell.Offset(a, 8).Value
   
        If ActiveCell.Offset(a, 2).Value = "Vendor ID:" Then
        TheVend = ActiveCell.Offset(a, 3).Value
        End If
        If (Len(Trim(LineCheck3)) <= 3) And (LineCheck3 <> "") And (LC2 <> "") And (LC5 <> "") And (LineCheck1 <> "Aged Totals:") Then
        ActiveCell.Offset(a, 0).Value = TheVend
       
        ' scan all columns from the right for the first value it can find for outstanding doc amt
            If LineCheck7 <> "" Then
            ActiveCell.Offset(a, 8).Value = LineCheck7
            Else
                Do While LC8 = "" And b < 15
                LC15 = ActiveCell.Offset(a, b).Value
                ActiveCell.Offset(a, 8).Value = LC15
                LC8 = ActiveCell.Offset(a, 8).Value
                ActiveCell.Offset(a, b).Value = ""
                b = b + 1
                Loop
                b = 6
            End If
        End If
    a = a + 1
    Loop
   
   
' Sort all records with a vendor
 Range("A1:Q50000").Select
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Sheet1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Sheet1").Sort
        .SetRange Range("A1:Q50000")
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
   
' Put in proper headers
    Rows("1:1").Select
    Selection.Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove
    Range("A1").Select
    ActiveCell.FormulaR1C1 = "VendorID"
    Range("B1").Select
    ActiveCell.FormulaR1C1 = "Index"
    Range("C1").Select
    ActiveCell.FormulaR1C1 = "VchrNmbr"
    Range("D1").Select
    ActiveCell.FormulaR1C1 = "DocNo"
    Range("E1").Select
    ActiveCell.FormulaR1C1 = "Type"
    Range("F1").Select
    ActiveCell.FormulaR1C1 = "DocDate"
    Range("G1").Select
    ActiveCell.FormulaR1C1 = "DueDate"
    Range("H1").Select
    ActiveCell.FormulaR1C1 = "OrigDocAmt"
    Range("I1").Select
    ActiveCell.FormulaR1C1 = "OSDocAmt"
    Range("A1").Select
   
    ' Copy good records to new sheet
    Range(Selection, Selection.End(xlDown)).Select
    Range(Selection, Selection.End(xlToRight)).Select
    Selection.Copy
    Sheets.Add After:=ActiveSheet
    Range("A1").Select
    ActiveSheet.Paste
    Range("A1").Select
   
    ' Remove unwanted characters like $
    Cells.Replace What:="$", Replacement:="", LookAt:=xlPart, SearchOrder:= _
        xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
       
    'Format amount column as currency
            Columns("H:I").Select
    Selection.Style = "Currency"
End Sub

No comments:

Post a Comment