Results 1 to 8 of 8

Thread: Excel Vba copy same date to list of entries

  1. #1

    Excel Vba copy same date to list of entries



    Register for a FREE account, and/
    or Log in to avoid these ads!

    Hi,
    I am copying a list of cell entries from invoice to ledger using vba. All the copied entries must have the same date as copied from the invoice sheet to the ledger sheet(per use of button).
    The next time the button is clicked, it should copy to the next empty rows on ledger sheet. Please help me with this. I cannot seem to get the date which is cell I5, to be copied against all the entries in Column A.

    Also for the ledger, I want it to print statement for a user defined period, say 01 Jan 2014 to 01 Jan 2015 or randomly such as 12 April 2015 to 12 May 2015. Please help on that also.

    Thank you

    Truly,
    Aneela
    Thank you

    Truly,
    Aneela
    Attached Files Attached Files

  2. #2
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,512
    Articles
    0
    Excel Version
    365
    similar/same cross posted:
    http://ccm.net/forum/affich-857645-c...ates-to-ledger
    http://stackoverflow.com/questions/3...ist-of-entries

    aneela1, for your information, you should always provide links to your cross posts.
    If you have cross posted at other places, please add links to them too.
    Why? Have a read of http://www.excelguru.ca/content.php?184

  3. #3
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,512
    Articles
    0
    Excel Version
    365
    Try the following (it has some changes I made which you may need to change back)
    Code:
    Sub Button1_click()
    
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Sheets("Invoice")
    Dim v As String
    Dim wb As String
    Const sPath As String = "F:\Software\"
    
    LastSrceRow = ws1.Range("B25").End(xlUp).Row
    v = "Ledger"  'ws1.Range("A5").Value 'you may need to alter this line..
    wb = v & ".xlsx"
    Workbooks.Open sPath & v & ".xlsx"
    nxtRw = Sheets("Ledger").Range("B" & Rows.Count).End(xlUp).Row + 1
    
    ws1.Range("B10:B" & LastSrceRow).Copy
    Workbooks(wb).Sheets("Ledger").Range("D" & nxtRw).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ws1.Range("G10:G" & LastSrceRow).Copy
    Workbooks(wb).Sheets("Ledger").Range("C" & nxtRw).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ws1.Range("H10:H" & LastSrceRow).Copy
    Workbooks(wb).Sheets("Ledger").Range("I" & nxtRw).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ws1.Range("I10:I" & LastSrceRow).Copy
    Workbooks(wb).Sheets("Ledger").Range("J" & nxtRw).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
    ws1.Range("I5:I6").Copy
    Workbooks(wb).Sheets("Ledger").Range("A" & nxtRw).Resize(LastSrceRow - 9, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    
    End Sub
    Regarding printing only certain date ranges, you can select all the header cells on row 9 (normally one cell would do but that doesn't seem to work well, it filters starting from the row below - probably because of merged cells?) and click (Auto)Filter on the Data tab of the ribbon, then in the date drop down look for the Date Filters option where you have a wealth of ways of filtering by date.
    Last edited by p45cal; 2015-11-24 at 04:55 PM.

  4. #4
    Wizard Pecoflyer's Avatar
    Join Date
    Oct 2011
    Location
    Brussels Belgium
    Posts
    1,615
    Articles
    0
    Excel Version
    2010 on Xubuntu
    Last edited by Pecoflyer; 2015-11-24 at 02:18 PM.

  5. #5
    I am sorry. I did not know that cross-posting was not allowed. I apologize. Thank you.

  6. #6
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,512
    Articles
    0
    Excel Version
    365
    Quote Originally Posted by aneela1 View Post
    I am sorry. I did not know that cross-posting was not allowed. I apologize. Thank you.
    Cross-posting is allowed (read the link) but if you must do it you must supply links to where you have cross posted (it's the same rule at most or all of the sites you've cross posted at).

  7. #7
    @p45cal Thank you. It does work. but it has some issues:

    1. invoice.xlsm has 15 rows where user can enter the data to be copied to ledger.xlsx, but if there are less than 15 items on the invoice, say 10 or 2, it still copies the date for 15 entries onto the ledgerPlease help with that.

    2. The number of rows in Column D for ledger.xlsx is 32(for A4 printing). If 15 items one time and then 15 items are added, only 2 rows are left. if a user enters more than 2 items excel errors and says that the size should be identical.

    Please could you:

    a. stop the copying process when the final limit of cell D43 is hit
    b. ask the user to print the current worksheet(which is full)
    c. add another worksheet to the workbook ledger for new copying and rename the current sheet.

  8. #8
    Super Moderator p45cal's Avatar
    Join Date
    Dec 2012
    Posts
    1,512
    Articles
    0
    Excel Version
    365
    Quote Originally Posted by aneela1 View Post
    It does work. but it has some issues:
    1. invoice.xlsm has 15 rows where user can enter the data to be copied to ledger.xlsx, but if there are less than 15 items on the invoice, say 10 or 2, it still copies the date for 15 entries onto the ledgerPlease help with that.
    I thought I had catered specifically for that (and tested on your sample file) with:
    LastSrceRow = ws1.Range("B25").End(xlUp).Row
    but maybe there is something in cells B24 and above which appear blank but are not; you can confirm by emulating what the code does by selecting cell B25, pressing the End key on the keyboard followed by the up-arrow on the keyboard. Is the last cell with data in column B not now selected?

    Quote Originally Posted by aneela1 View Post
    2. The number of rows in Column D for ledger.xlsx is 32(for A4 printing). If 15 items one time and then 15 items are added, only 2 rows are left. if a user enters more than 2 items excel errors and says that the size should be identical.

    Please could you:

    a. stop the copying process when the final limit of cell D43 is hit
    Code:
    Sub Button1_click()
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Sheets("Invoice")
    Dim v As String
    Dim wb As String
    Const sPath As String = "F:\Software\"
    
    LastSrceRow = ws1.Range("B25").End(xlUp).Row
    v = "Ledger"  'ws1.Range("A5").Value
    wb = v & ".xlsx"
    Workbooks.Open sPath & v & ".xlsx"
    nxtRw = Sheets("Ledger").Range("B" & Rows.Count).End(xlUp).Row + 1
    If nxtRw + LastSrceRow - 10 > 43 Then
      MsgBox "Too many rows to copy - aborting copy"
    Else
      ws1.Range("B10:B" & LastSrceRow).Copy
      Workbooks(wb).Sheets("Ledger").Range("D" & nxtRw).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
      ws1.Range("G10:G" & LastSrceRow).Copy
      Workbooks(wb).Sheets("Ledger").Range("C" & nxtRw).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
      ws1.Range("H10:H" & LastSrceRow).Copy
      Workbooks(wb).Sheets("Ledger").Range("I" & nxtRw).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
      ws1.Range("I10:I" & LastSrceRow).Copy
      Workbooks(wb).Sheets("Ledger").Range("J" & nxtRw).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
    
      ws1.Range("I5:I6").Copy
      Workbooks(wb).Sheets("Ledger").Range("A" & nxtRw).Resize(LastSrceRow - 9, 2).PasteSpecial Paste:=xlValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=True
    End If
    End Sub
    Quote Originally Posted by aneela1 View Post
    b. ask the user to print the current worksheet(which is full)
    c. add another worksheet to the workbook ledger for new copying and rename the current sheet.

    Out of time for that - create a new thread perhaps?
    Last edited by p45cal; 2015-11-24 at 06:36 PM.

Posting Permissions

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