Copy daily cost entries into the particular ledgers [Solved/Closed]

Report
Posts
5
Registration date
Monday December 29, 2014
Status
Member
Last seen
December 30, 2014
-
Posts
1260
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
February 3, 2020
-
Hello,

I want to copy the daily cost entires into the particular ledgers, which i put in different sheets.

Ex: I have the following data:
Date Item No. of units Price/unit Total Comments Ledger(to which ledger the following entry should go)

Based on the Ledger entry, the data in that row should be copied to a different sheet

Can you please help me on this.

2 replies

Posts
1260
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
February 3, 2020
213
Hello Shanthich,

Could you please upload a sample of your workbook so that we can see exactly what you would like to do. Show the input and expected output result.

You can use a file sharing site such as DropBox. Please desensitise any confidential data.

Regards,
vcoolio.
Posts
5
Registration date
Monday December 29, 2014
Status
Member
Last seen
December 30, 2014
1
Hi Vcoolio,

This is the input data: that is fed in on a daily basis. This should be copied into separate sheets with the name of the 'Ledger' in Column A

Ledger Date Item No. of units Price/Unit Total
Milk 01/08/13 Milk 90 31.5 2835
Milk 02/08/13 Milk 10 34 340
Milk 03/08/13 Milk 5 34 170
Vegetables 01/08/13 Vegetables 20
Vegetables 02/08/13 Greenleaf 20
Vegetables 06/08/13 Onions 170
Misc. 03/08/13 Bread 53
Misc. 03/08/13 Bread 53
Transport 04/08/13 Auto Charges 100

Hope this is clear.
Posts
1260
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
February 3, 2020
213 >
Posts
5
Registration date
Monday December 29, 2014
Status
Member
Last seen
December 30, 2014

Hello Shanthich,

I think this code may help you:-

Sub TransferData()
  Dim ws As Worksheet
  Dim lrow As Long
  Dim rng As Range
  Set ws = Sheets("Ledger")
  lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In ws.Range("A2:A" & lrow)
  Text = Left(rng.Value, 10)
Select Case Text
    Case Is = "Milk"
    rng.EntireRow.Copy Sheets("Milk").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Case Is = "Vegetables"
    rng.EntireRow.Copy Sheets("Vegetables").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Case Is = "Misc."
    rng.EntireRow.Copy Sheets("Misc.").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
    Case Is = "Transport"
    rng.EntireRow.Copy Sheets("Transport").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0)
End Select
Next
 ws.Range("A2:F" & Rows.Count).Rows.ClearContents
Beep
MsgBox "Data transfer complete!", vbExclamation
End Sub



You can have a look at my test workbook at this link:-

https://www.dropbox.com/s/eermk69exndncs5/Shanthich.xlsm?dl=0

to see if it is what you had in mind.

The code also deletes the input data in the "Ledger" sheet after it is transferred to the various other sheets as I assumed that you would not want to clutter up the "Ledger" sheet with used data.

Kind regards,
vcoolio.
Posts
5
Registration date
Monday December 29, 2014
Status
Member
Last seen
December 30, 2014
1 >
Posts
1260
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
February 3, 2020

Dear vcoolio,

This is exactly what i am looking for. Thanks a lot :)

Regards,
Shanthich
Posts
1260
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
February 3, 2020
213 >
Posts
5
Registration date
Monday December 29, 2014
Status
Member
Last seen
December 30, 2014

Hi Shanthich,

Glad that I could help.

BTW, another close one in the Third Test in Melbourne!

Cheers,
vcoolio.
Posts
1260
Registration date
Thursday July 24, 2014
Status
Moderator
Last seen
February 3, 2020
213
Hello again Shanthich,

Just a little addition to the code that I forgot about yesterday. Its up to you whether or not you use it. I've just added a simple sum formula to the "Total" column in the "Ledger" sheet which will calculate columns D & E for you. Only the values will be transferred to the various other sheets and the formulae will remain intact in the "Ledger" sheet after its contents are cleared. This is the amended code:-

Sub TransferData()
Application.ScreenUpdating = False
  Dim ws As Worksheet
  Dim lrow As Long
  Dim rng As Range
  Set ws = Sheets("Ledger")
  lrow = ws.Cells(Rows.Count, 1).End(xlUp).Row
For Each rng In ws.Range("A2:A" & lrow)
  Text = Left(rng.Value, 10)
Select Case Text
    Case Is = "Milk"
    rng.EntireRow.Copy
    Sheets("Milk").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Case Is = "Vegetables"
    rng.EntireRow.Copy
    Sheets("Vegetables").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Case Is = "Misc."
    rng.EntireRow.Copy
    Sheets("Misc.").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
    Case Is = "Transport"
    rng.EntireRow.Copy
    Sheets("Transport").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
End Select
Next
 ws.Range("A2:E" & Rows.Count).Rows.ClearContents
Beep
MsgBox "Data transfer complete!", vbExclamation
Application.ScreenUpdating = True
End Sub


You can also have a look at how it works in my test workbook here:-

https://www.dropbox.com/s/hnncnzpkxvazcrb/Shanthich%282%29.xlsm?dl=0

Again, its up to you whether you use it or not.

Kind regards,
vcoolio.