You original data didn't have two different BOL on the same date so I didn't
know to seperate the BOL's. The new code will seperate sections eiuther if
the DATE or the BOL don't match in two consecutive rows.

Sub ConvertQuickbook()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
TABChr = Chr(9)

Set fswrite = CreateObject("Scripting.FileSystemObject")

folder = "C:\temp"
'folder = ThisWorkbook.Path
ChDir (folder)

FNAME = Application.GetSaveAsFilename( _
fileFilter:="Quickbook Files (*.iif), *.iif")

If FNAME < False Then
fswrite.CreateTextFile FNAME
Set fwrite = fswrite.GetFile(FNAME)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

OutPutLine = "!TRNS,TYPE,DATE,ACCNT,NAME," & _
"AMOUNT,DOCNUM,TOPRINT,TAXABLE,ADDR1"
tswrite.writeline OutPutLine
OutPutLine = "!SPL,TYPE,DATE,ACCNT,NAME," & _
"AMOUNT,DOCNUM,QNTY,PRICE,INVITEM"
tswrite.writeline OutPutLine
OutPutLine = "!ENDTRNS"
tswrite.writeline OutPutLine
tswrite.writeline

RowCount = 2
Do While Range("A" & RowCount) < ""
TransDate = Range("A" & RowCount)
LastTransDate = Range("A" & (RowCount - 1))
BOL = Range("B" & RowCount)
LastBOL = Range("B" & (RowCount - 1))
If (TransDate < LastTransDate) Or _
(BOL < LastBOL) Then

StrDate = Range("A" & RowCount).Text
TotalAmount = WorksheetFunction.SumIf(Columns("A"), _
TransDate, Columns("F"))
OutPutLine = "TRNS',INVOICE," & _
StrDate & ",AR," & COMPANY & _
"," & TotalAmount & ",BOL"
tswrite.writeline OutPutLine
End If
PartNumber = Range("C" & RowCount)
Quant = Range("D" & RowCount)
Price = Range("E" & RowCount)
Amount = -1 * Range("F" & RowCount)
COMPANY = Range("G" & RowCount)
OutPutLine = "SPL,INVOICE," & StrDate & ",Sales,," & Amount & "," & _
BOL & "," & Quant & "," & Price & "," & PartNumber
tswrite.writeline OutPutLine

NextTransDate = Range("A" & (RowCount + 1))
NextBOL = Range("B" & (RowCount + 1))
If (TransDate < NextTransDate) Or _
(BOL < NextBOL) Then
OutPutLine = "ENDTRNS"
tswrite.writeline OutPutLine
tswrite.writeline
End If
RowCount = RowCount + 1
Loop
End If
tswrite.Close
End Sub




"basic" wrote:

Joel-

Everything is working great except it is not seperating the transactions by
BOL, instead it looks like it is seperating by the ship date.

When I imported it I also realized that I had left out two other adjustments.
1. Instead of having the Customer default to "ABC", can you make it so it
picks up the actual customer that is in column G?

2. Can you make the amount entered in the !SPl line a negitive. (Example:
-2500.00). The amount in the !TRNS line should remain positive.

I hope this is the last time, but thanks a million for you help!


"Joel" wrote:

The code saves the file as a iif suffix in CVS format. If there is a
problem, you may have to add or eliminate some of the commas.

Sub ConvertQuickbook()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const COMPANY = "ABC"
TABChr = Chr(9)

Set fswrite = CreateObject("Scripting.FileSystemObject")

folder = "C:\temp"
'folder = ThisWorkbook.Path
ChDir (folder)

FNAME = Application.GetSaveAsFilename( _
fileFilter:="Quickbook Files (*.iif), *.iif")

If FNAME < False Then
fswrite.CreateTextFile FNAME
Set fwrite = fswrite.GetFile(FNAME)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

OutPutLine = "!TRNS,TYPE,DATE,ACCNT,NAME," & _
"AMOUNT,DOCNUM,TOPRINT,TAXABLE,ADDR1"
tswrite.writeline OutPutLine
OutPutLine = "!SPL,TYPE,DATE,ACCNT,NAME," & _
"AMOUNT,DOCNUM,QNTY,PRICE,INVITEM"
tswrite.writeline OutPutLine
OutPutLine = "!ENDTRNS"
tswrite.writeline OutPutLine
tswrite.writeline

RowCount = 2
Do While Range("A" & RowCount) < ""
TransDate = Range("A" & RowCount)
LastTransDate = Range("A" & (RowCount - 1))
BOL = Range("B" & RowCount)
If TransDate < LastTransDate Then

StrDate = Range("A" & RowCount).Text
TotalAmount = WorksheetFunction.SumIf(Columns("A"), _
TransDate, Columns("F"))
OutPutLine = "TRNS',INVOICE," & _
StrDate & ",AR," & COMPANY & _
"," & TotalAmount & ",BOL"
tswrite.writeline OutPutLine
End If
PartNumber = Range("C" & RowCount)
Quant = Range("D" & RowCount)
Price = Range("E" & RowCount)
Amount = Range("F" & RowCount)
OutPutLine = "SPL,INVOICE," & StrDate & ",Sales,," & Amount & "," & _
BOL & "," & Quant & "," & Price & "," & PartNumber
tswrite.writeline OutPutLine

NextTransDate = Range("A" & (RowCount + 1))
If TransDate < NextTransDate Then
OutPutLine = "ENDTRNS"
tswrite.writeline OutPutLine
tswrite.writeline
End If
RowCount = RowCount + 1
Loop
End If
tswrite.Close
End Sub

"basic" wrote:

Joel-

Sorry I tried to keep it simple for the original posting because I thought
it would be too complicated to explain. Obviously you have proven me wrong.
Here is exactly what I am looking for.

My original data is in Access. I am exporting this data into excel, adding
the neccesary titles and data and then saving it as a cvs file in excel. I
then change the cvs extension to an iif extension in order to import it into
quickbooks. If you have any shortcut ideas please use them.

If you don't have a "better" way then the import template for quickbooks
requires each heading in its own cell. The data that corresponds with the
headings should be in the cells beneath the heading. Here is the exact layout
with headers.

Should be in cells A1..S1
!Trns TRNSID TRNSTYPE DATE ACCNT NAME CLASS AMOUNT DOCNUM
MEMO CLEAR TOPRINT NAMEST ADDR1 ADDR2 ADDR3 TERMS SHIPVIA
SHIPDATE

Should be in cells A2..S2
!Spl SPLID TRNSTYPE DATE ACCNT NAME CLASS AMOUNT DOCNUM
MEMO CLEAR QNTY PRICE INVITEM OTHER1 TAXABLE OTHER2
YEARTODATE WAGEBASE

Should be in cell A3
!ENDTRNS

The transactions should line up under the correct headings when complete.

Again thanks for all your help.



"Joel" wrote:

Is the data meant to go in a spreadsheet or do you need it to go in to a text
file? You asked for an export file which is general intepreted as a text
file. I seperated the columns with tabs because you original output data was
TAB delimited. I can change the code to be fixed spaced or delimited any way
you like. I don't know which is the best method. From your lasted
description you are referencing cell in a spreadsheet so I'm a little
confused. If you are importing the data into a worksheet, then try using TAB
delimited as the option for importing.

"basic" wrote:

Joel-
Very impressive! It is almost exactly what I am looking for.
There are just a couple problems.
1. The "Total Amount" in the first line is ok, but the individual totals
which should be below the "Total Amount" are moved to the right one column.
Also the BOL and the Quantity columns are getting combined into one column.

2. If possible the top three header rows you created should be all
individual cells going across, they are actually headers for the detail.

Thanks again!

"Joel" wrote:

The problem was with the lenght of the lines. Whenyou post code that has
more than 80 characters on a line the line wraps to two lines. I fixed the
code below so this doesn't happen. I added the underline character
(continuation line) at the end of all of the long lines to prevent errors.

Sub ConvertQuickbook()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const COMPANY = "ABC"
TABChr = Chr(9)

Set fswrite = CreateObject("Scripting.FileSystemObject")

folder = "C:\temp"
'folder = ThisWorkbook.Path
ChDir (folder)

FNAME = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.txt), *.txt")

If FNAME < False Then
fswrite.CreateTextFile FNAME
Set fwrite = fswrite.GetFile(FNAME)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

OutPutLine = "!TRNS TYPE DATE ACCNT NAME " & _
"AMOUNT DOCNUM TOPRINT TAXABLE ADDR1"
tswrite.writeline OutPutLine
OutPutLine = "!SPL TYPE DATE ACCNT NAME " & _
"AMOUNT DOCNUM QNTY PRICE INVITEM"
tswrite.writeline OutPutLine
OutPutLine = "!ENDTRNS"
tswrite.writeline OutPutLine
tswrite.writeline

RowCount = 2
Do While Range("A" & RowCount) < ""
TransDate = Range("A" & RowCount)
LastTransDate = Range("A" & (RowCount - 1))
BOL = Range("B" & RowCount)
If TransDate < LastTransDate Then

StrDate = Range("A" & RowCount).Text
TotalAmount = WorksheetFunction.SumIf(Columns("A"), _
TransDate, Columns("F"))
OutPutLine = "TRNS" & TABChr & "INVOICE" & TABChr & _
StrDate & TABChr & "AR" & TABChr & COMPANY & _
TABChr & TotalAmount & TABChr & "BOL"
tswrite.writeline OutPutLine
End If
PartNumber = Range("C" & RowCount)
Quant = Range("D" & RowCount)
Price = Range("E" & RowCount)
Amount = Range("F" & RowCount)
OutPutLine = "SPL" & TABChr & "INVOICE" & TABChr & StrDate & TABChr & _
"Sales" & TABChr & TABChr & TABChr & Amount & TABChr & _
BOL & Quant & TABChr & Price & TABChr & PartNumber
tswrite.writeline OutPutLine

NextTransDate = Range("A" & (RowCount + 1))
If TransDate < NextTransDate Then
OutPutLine = "ENDTRNS"
tswrite.writeline OutPutLine
tswrite.writeline
End If
RowCount = RowCount + 1
Loop
End If
tswrite.Close
End Sub


"basic" wrote:

Joel-

Thanks for the help. Your code is way over my head to try to troubleshoot.
I am running into a compile error; Syntax error.


The following shows in red when I copy it into a macro. It then gives the
"compiler error/Syntax error when I run it:
Red:
TotalAmount = WorksheetFunction.SumIf(Columns("A"), TransDate,
Columns("F"))
OutPutLine = "TRNS" & TABChr & "INVOICE" & TABChr & StrDate &
TABChr & _
"AR" & TABChr & COMPANY & TABChr & TotalAmount &
TABChr & "BOL"
tswrite.writeline OutPutLine
End If
PartNumber = Range("C" & RowCount)
Quant = Range("D" & RowCount)
Price = Range("E" & RowCount)
Amount = Range("F" & RowCount)
Red: OutPutLine = "SPL" & TABChr & "INVOICE" & TABChr & StrDate &
TABChr & _
"Sales" & TABChr & TABChr & TABChr & Amount & TABChr &
BOL & _
Quant & TABChr & Price & TABChr & PartNumber


"Joel" wrote:

Sub ConvertQuickbook()

Const ForReading = 1, ForWriting = 2, ForAppending = 3
Const TristateUseDefault = -2, TristateTrue = -1, TristateFalse = 0
Const COMPANY = "ABC"
TABChr = Chr(9)

Set fswrite = CreateObject("Scripting.FileSystemObject")

folder = "C:\temp"
'folder = ThisWorkbook.Path
ChDir (folder)

FName = Application.GetSaveAsFilename( _
fileFilter:="Text Files (*.txt), *.txt")

If FName < False Then
fswrite.CreateTextFile FName
Set fwrite = fswrite.GetFile(FName)
Set tswrite = fwrite.OpenAsTextStream(ForWriting, TristateUseDefault)

OutPutLine = "!TRNS TYPE DATE ACCNT NAME " & _
"AMOUNT DOCNUM TOPRINT TAXABLE ADDR1"
tswrite.writeline OutPutLine
OutPutLine = "!SPL TYPE DATE ACCNT NAME " & _
"AMOUNT DOCNUM QNTY PRICE INVITEM"
tswrite.writeline OutPutLine
OutPutLine = "!ENDTRNS"
tswrite.writeline OutPutLine
tswrite.writeline

RowCount = 2
Do While Range("A" & RowCount) < ""
TransDate = Range("A" & RowCount)
LastTransDate = Range("A" & (RowCount - 1))
BOL = Range("B" & RowCount)
If TransDate < LastTransDate Then

StrDate = Range("A" & RowCount).Text
TotalAmount = WorksheetFunction.SumIf(Columns("A"), TransDate,
Columns("F"))
OutPutLine = "TRNS" & TABChr & "INVOICE" & TABChr & StrDate &
TABChr & _
"AR" & TABChr & COMPANY & TABChr & TotalAmount &
TABChr & "BOL"