VBA: Combine data within the respective sheets

Aberdham

Board Regular
Joined
Mar 8, 2018
Messages
163
Office Version
  1. 365
Platform
  1. Windows
Hi All,

So I have a workbook with 3 type of invoices within 3 sheets: (Historical; Sales cost; Purchase cost)
each sheet has a unique identifier as H,R,P in column A;
in Column J e.g. Machinery, so far we have 75 machinery, therefore 75 Sheets.

I was able to pull all the data from all the 3 invoice Sheets into overview machinery 1 with the following code:

Public Sub CombineDataFromAllSheets()
Dim wksSrc As Worksheet, wksDst As Worksheet
Dim rngSrc As Range, rngDst As Range
Dim lngLastCol As Long, lngSrcLastRow As Long, lngDstLastRow As Long

'Set references up-front
Set wksDst = ThisWorkbook.Worksheets("Overview Machinery 1")
lngDstLastRow = LastOccupiedRowNum(wksDst)
lngLastCol = LastOccupiedColNum(wksDst)

'Set the destination range
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

'Looping through
For Each wksSrc In ThisWorkbook.Worksheets

If wksSrc.Name <> "Overview Machinery 1" Then

lngSrcLastRow = LastOccupiedRowNum(wksSrc)

'Store all relevant source data then copy it to the destination range
With wksSrc
Set rngSrc = .Range(.Cells(2, 1), .Cells(lngSrcLastRow, lngLastCol))
rngSrc.Copy Destination:=rngDst
End With

'Redefine the destination range that new data has been added
lngDstLastRow = LastOccupiedRowNum(wksDst)
Set rngDst = wksDst.Cells(lngDstLastRow + 1, 1)

End If

Next wksSrc
End Sub
'INPUT : Sheet, the worksheet we are going to search to find the last row
'OUTPUT : Long, the last occupied row
'SPECIAL CASE: if Sheet is empty, return as 1
Public Function LastOccupiedRowNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Row
End With
Else
lng = 1
End If
LastOccupiedRowNum = lng
End Function
'INPUT : Sheet, the worksheet we are going search to find the last column
'OUTPUT : Long, the last occupied column
'SPECIAL CASE: if Sheet is empty, return as 1
Public Function LastOccupiedColNum(Sheet As Worksheet) As Long
Dim lng As Long
If Application.WorksheetFunction.CountA(Sheet.Cells) <> 0 Then
With Sheet
lng = .Cells.Find(What:="*", _
After:=.Range("A1"), _
Lookat:=xlPart, _
LookIn:=xlFormulas, _
SearchOrder:=xlByColumns, _
SearchDirection:=xlPrevious, _
MatchCase:=False).Column
End With
Else
lng = 1
End If
LastOccupiedColNum = lng
End Function

I would like to know how to pull the necessary data from the 3 invoice Sheets to the respective overview machine Sheets (1-75) based on column J?

Furthermore, this is probably a silly question, But I would like to ask that whenever i have new entries, do I have to run the macro again and delete the duplicate ones to include the new entries? or is there a way to modify the code to automatcally update to the respective machinery Sheets?

Please let me know if you Need further clarifications!

Any help would be greatly appreciated !

Regards,
M
sheet 1 (historical):
Invoice typeInvoice NumberSupplier/DebitorDescriptionInvoice DateFX rateUSD AmountEUR AmountChange in InventoryMachineryCategory
HK8554214ADADeposit SN 8444511-12-20171,1885$361.067,54303.801,05 €-303.801,05 €1
HK8554215ADAfinal payment_ESN 8484621-1-20181,1993$358.718,75299.106,77 €-299.106,77 €1
HK8554216APOMfinal payment_ESN 8484622-2-20181,2492$ 2.600,602.081,82 €-2.081,82 €1
H85426589APOMinspection2-2-20181,2492$ 3.461,332.770,84 €-2.770,84 €1
H85426589UIJopmen2-2-20181,2492$ 18.988,9415.200,88 €-15.200,88 €1
Sheet 2 (sales)
Type of invoiceInvoice NumberSupplier/DebitorDescriptionInvoice DateFX rateUSD AmountEUR AmountChange in InventoryMachineryCategory
RAR00214522ADAAR0025145211-4-20181,2384$ 15.222,00€ 12.291,67-12.291,67 €1
sheet 3( purchase)
Type of invoiceInvoice NumberSupplier/DebitorDescriptionInvoice DateFX rateUSD AmountEUR AmountChange in InventoryMachineryCategory
P58485AADAP00152311-4-20181,2384$ 15.222,00€ 12.291,6712.291,67 €1
P584885AARAP0015241-4-20181,2321$ 1.600,00€ 1.298,601.298,60 €1
P584882AAEAP0015251-4-20181,2321$ 500,00€ 405,81405,81 €1
P48595AESAP0015261-4-20181,2321$ 18.455,00€ 14.978,4914.978,49 €1
P485953AHJAP0015271-4-20181,2321$ 16.746,00€ 13.591,4313.591,43 €1
P1007019UIJAP0015281-4-20181,2321$ 6.200,00€ 5.050,515.050,51 €1
P1007020JIMKAP0015291-4-20181,2321$ 35.000,00€ 28.434,4828.434,48 €1
P8958952KYTAP0015301-4-20181,2321$2.000.000,00€ 1.617.992,071.


<tbody>
</tbody><colgroup><col><col><col><col><col><col><col><col><col><col><col></colgroup>
 

Excel Facts

Difference between two dates
Secret function! Use =DATEDIF(A2,B2,"Y")&" years"&=DATEDIF(A2,B2,"YM")&" months"&=DATEDIF(A2,B2,"MD")&" days"

Forum statistics

Threads
1,214,590
Messages
6,120,421
Members
448,961
Latest member
nzskater

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