VB 6.0 - Generating Invoices

To copy to another workbook follow this idea:

Sub Demo()
    Dim wb1 As Excel.Workbook
    Dim wb2 As Excel.Workbook
    Set wb1 = ActiveWorkbook
    
    Dim myExcelApp As New Excel.Application
    myExcelApp.Visible = True
    Set wb2 = myExcelApp.Workbooks.Add
    
    Dim r As Excel.Range
    Set r = wb1.ActiveSheet.Range("A1:A2")
    
    Dim c As Excel.Range
    For Each c In r.Cells
        wb2.Worksheets("Sheet1").Range(c.Address).Value = c.Value
    Next
End Sub

Option Explicit

Sub TransferData()
    Dim wkb As Workbook, wks As Worksheet, LastRow As Long
    Dim FilePath As String, FileName As String
    Dim ws As Worksheet, blnOpened As Boolean
    'Change these variables as desired...
    FilePath = "C:\YourFullFilePathHere\" 'change path here
    FileName = "Book2.xls" 'change name here
    Call ToggleEvents(False)
    Set ws = ThisWorkbook.Sheets("Sheet1") 'change source sheet name here
    If WbOpen(FileName) = True Then
        Set wkb = Workbooks(FileName)
        blnOpened = False
    Else
        If Right(FilePath, 1) <> Application.PathSeparator Then
            FilePath = FilePath & Application.PathSeparator
        End If
        Set wkb = Workbooks.Open(FilePath & FileName)
        blnOpened = True
    End If
    Set wks = wkb.Sheets("Sheet1") 'change destination sheet name here
    LastRow = wks.Cells.Find(what:="*", after:=wks.Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
    wks.Cells(LastRow, "A").Value = ws.Cells(1, "B").Value
    wks.Cells(LastRow, "B").Value = ws.Cells(4, "B").Value
    wks.Cells(LastRow, "C").Value = ws.Cells(7, "B").Value
    wks.Cells(LastRow, "D").Value = ws.Cells(7, "E").Value
    If blnOpened = True Then
        wkb.Close SaveChanges:=True
    End If
    If MsgBox("Clear values?", vbYesNo, "CLEAR?") = vbYes Then
        Call ClearData
    End If
    Call ToggleEvents(True)
End Sub

Sub ClearData()
    Dim ws As Worksheet
    Set ws = ThisWorkbook.Sheets("Sheet1") 'change as desired
    ws.Range("B1").ClearContents 'Name
    ws.Range("B4").ClearContents 'Address
    ws.Range("B7").ClearContents 'Age
    ws.Range("E7").ClearContents 'Sex
End Sub

Sub ToggleEvents(blnState As Boolean)
'Originally written by firefytr
    With Application
        .DisplayAlerts = blnState
        .EnableEvents = blnState
        .ScreenUpdating = blnState
        If blnState Then .CutCopyMode = False
        If blnState Then .StatusBar = False
    End With
End Sub

Function WbOpen(wbName As String) As Boolean
'Originally found written by Jake Marx
    On Error Resume Next
    WbOpen = Len(Workbooks(wbName).Name)
End Function

Hi Malkit:

you should probably contact Zack directly with your question on how to interpret his code, but I will give it a try, as neutral party so to speak. I have worked with a lot of people with RF background in my past, so I understand how frustrated you must feel.

I have embedded my interpretation comments in Zack's code. I am not sure whether they will be much help.

Please don't hesitate to contact me with more questions. If you think a contractual arrangement in the context of a larger project might help I am doing this for a living now (although my background is in physics).

Best wishes,
Rolf
SoarentComputing
http://soarentcomputing.com/
510.300.7462

Option Explicit
Sub TransferData()
    Dim wkb As Workbook, wks As Worksheet, LastRow As Long
    Dim FilePath As String, FileName As String
    Dim ws As Worksheet, blnOpened As Boolean
    'Change these variables as desired...
    FilePath = "C:\YourFullFilePathHere\"
    'change path here    FileName = "Book2.xls"
    'change name here    Call ToggleEvents(False)
    'Rolfs comment:
    ' I presume ws is intended to be the active worksheet in your workbook Book1
    Set ws = ThisWorkbook.Sheets("Sheet1")
    'change source sheet name here
    
    'Rolfs comments:
    ' I presume FileName is intended to be the name of your workbook Book2
    ' The next couple of lines are just making sure that the workbook is actually open

    If WbOpen(FileName) = True Then
        Set wkb = Workbooks(FileName)
        blnOpened = False
    Else
        If Right(FilePath, 1) <> Application.PathSeparator Then
            FilePath = FilePath & Application.PathSeparator
        End If
        Set wkb = Workbooks.Open(FilePath & FileName)
        blnOpened = True
    End If
    Set wks = wkb.Sheets("Sheet1")
    'change destination sheet name here
    
    'Rolfs comment:
    ' This line simply sets LastRow to the index of the first empty row
    LastRow = wks.Cells.Find(what:="*", after:=wks.Cells(1, 1), searchorder:=xlByRows, searchdirection:=xlPrevious).Row + 1
    'Rolfs comments:
    ' Here is where the copying of values from Book1 to Book2 is taking place.
    ' Let's for the moment for the sake of simplicity say that the value of the LastRow index is n.
    ' The next couple of lines will now make the following range copies:
    ' Cell "An" in Book1 to Cell "B1"
    ' Cell "Bn" in Book1 to Cell "B4"
    ' Cell "Cn" in Book1 to Cell "B7"
    ' Cell "Dn" in Book1 to Cell "E7"
    ' This seems a bit odd. Is that what you want?
    wks.Cells(LastRow, "A").Value = ws.Cells(1, "B").Value
    wks.Cells(LastRow, "B").Value = ws.Cells(4, "B").Value
    wks.Cells(LastRow, "C").Value = ws.Cells(7, "B").Value
    wks.Cells(LastRow, "D").Value = ws.Cells(7, "E").Value
    If blnOpened = True Then
        wkb.Close SaveChanges:=True
    End If
    If MsgBox("Clear values?", vbYesNo, "CLEAR?") = vbYes Then
        Call ClearData
    End If
    Call ToggleEvents(True)
End Sub