VBA code to copy line above with changes.

shophoney

Active Member
Joined
Jun 16, 2014
Messages
281
Hello,

I'm looking for some help on VBA. The code is to create a file to import into QuickBooks for invoices.

I have some code i've written that takes a pivottable and copies it to a new tab. Pastes it as values and insets a blank line.

I would like to add another line that is the "SPL" that is the same as the line above but with a negative value adding "Owners Draw" to the ACCOUNT.

Example below adds line 5. A5= SPL. E5= Owners Draw. G5=-G4. Add line 6, A6 = ENDTRNS.

1655652720517.png



Sub Quickbooks_Import()
Dim ws As Worksheet
Dim rng As Range

Range("A1").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Selection.SpecialCells(xlCellTypeVisible).Select
Selection.Copy

Set ws = Worksheets.Add(after:=Sheets("QB Import"))
ws.Name = "QB iif " & Format(Date, "mm_dd_yy") & "@" & Format(Time, "hhmm")


Selection.PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Operation:= _
xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False

Application.GoTo Reference:="R1C1"
Rows("3:3").Select
Selection.Delete Shift:=xlUp

Call InsertOwnersDraw
Call InsertENDTRNS

ChDir "D:\Dropbox\FaceUp Innovations Consulting Inc\Import"
ActiveWorkbook.SaveAs Filename:= _
"D:\Dropbox\FaceUp Innovations Consulting Inc\Import\Export.iif" & Format(Date, "mm_dd_yy") & "@" & Format(Time, "hhmm"), FileFormat:=xlText, _
CreateBackup:=False
End Sub

Sub InsertOwnersDraw()

Dim export As Worksheet
Dim UnnecessaryRow As Range
Dim TRNS_ROW As Range

Set TRNS_ROW = Range("A4")

While TRNS_ROW.Value <> ""

If TRNS_ROW.Value = "TRNS" And TRNS_ROW.Offset(-1, 0) <> "SPL" Then

TRNS_ROW.EntireRow.Insert

TRNS_ROW.Offset(-1, 0) = "SPL"

End If

If TRNS_ROW.Value = "SPL" And TRNS_ROW.Offset(1, 0) = "" Then

TRNS_ROW.Offset(1, 0) = "SPL"

End If

Set TRNS_ROW = TRNS_ROW.Offset(1)

Wend

End Sub

Sub InsertENDTRNS()

Dim export As Worksheet
Dim UnnecessaryRow As Range
Dim TRNS_ROW As Range

'Set UnnecessaryRow = Range("A3")

'UnnecessaryRow.EntireRow.Delete

Set TRNS_ROW = Range("A4")

While TRNS_ROW.Value <> ""

If TRNS_ROW.Value = "TRNS" And TRNS_ROW.Offset(-1, 0) <> "ENDTRNS" Then

TRNS_ROW.EntireRow.Insert

TRNS_ROW.Offset(-1, 0) = "ENDTRNS"

End If

If TRNS_ROW.Value = "SPL" And TRNS_ROW.Offset(1, 0) = "" Then

TRNS_ROW.Offset(1, 0) = "ENDTRNS"

End If

Set TRNS_ROW = TRNS_ROW.Offset(1)

Wend

End Sub






 

Excel Facts

Control Word Wrap
Press Alt+Enter to move to a new row in a cell. Lets you control where the words wrap.

Forum statistics

Threads
1,214,643
Messages
6,120,702
Members
448,980
Latest member
CarlosWin

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top