Reputation: 339
I have a workbook that fetches data from several other worksheets. Usually, the data is stored in a table in each sheet. In this case, one table is a data connection to our database where our orders are stored.
In order to successfully get the correct data from each sheet, I create a 'Data' sub that looks something like this:
Dim Wb(1 To 10) As Workbook
Dim Sh(1 To 10) As Worksheet
Dim Lo(1 To 10) As ListObject
Dim Ii&(1 To 10), Jj&(1 To 10), Kk&(1 To 10)
Sub Data()
Set Wb(1) = ThisWorkbook
Set Sh(1) = Wb(1).Worksheets("Input")
Set Lo(1) = Sh(1).ListObjects("Input")
With Lo(1)
Ii(1) = .ListColumns("Date").Range.Column
Ii(2) = .ListColumns("ArtNo").Range.Column
Ii(3) = .ListColumns("ArtName").Range.Column
Ii(4) = .ListColumns("ArtUnits").Range.Column ' Units in the article
Ii(5) = .ListColumns("ArtLitres").Range.Column ' Litres in the article
Ii(6) = .ListColumns("Quantity").Range.Column
Ii(7) = .ListColumns("SumUnits").Range.Columne ' Units * Quantity
Ii(8) = .ListColumns("SumLitres").Range.Columne ' Litres * Quantity
End With
' Table from Database containing the orders
Set Sh(2) = Wb(1).Worksheets("Orders")
Set Lo(2) = Sh(2).ListObjects("Orders")
With Lo(2)
Jj(1) = .ListColumns("Date").Range.Column
Jj(2) = .ListColumns("ArtNo").Range.Column
Jj(6) = .ListColumns("Quantity").Range.Column
End With
' Database containing detailed information on the articles
Set Sh(3) = Wb(1).Worksheets("ArtData")
Set Lo(3) = Sh(3).ListObjects("ArtData")
With Lo(3)
Kk(2) = .ListColumns("ArtNo").Range.Column
Kk(3) = .ListColumns("ArtName").Range.Column
Kk(4) = .ListColumns("ArtUnits").Range.Column ' Units in the article
Kk(5) = .ListColumns("ArtLitres").Range.Column ' Litres in the article
End With
End Sub
So, when I've run the Data sub, I know where all the relevant columns are. And I have seen to it that each number represents the same column name. By that I mean that Ii(2), Jj(2) and Kk(2) all equal the column named "ArtNo" in each table.
I started using arrays because they are quicker to declare. Instead of declaring separate integers, like "ArtNo1", "ArtNo2", "ArtNo3" or ArtNo(1 to 3), I'd simply know that the digit (1) equals ArtNo in each table, and I'd use one Array ("Ii", "Jj", "Kk") per table. I will only have to know what each digit represents and worst case; I would scroll up to the Data sub and get the answer there.
In order to get data I'd do something like this:
Sub TransferData()
Dim dDate As Date
Dim Str$
Dim Cel As Range
Dim X&, Y&
CalcOff
Data
Wb(1).RefreshAll ' Updates the Order data connection
X = Lo(1).DataBodyRange.Row ' Get input row for the data
Str = Format(dDate, "yyyy-mm-dd", vbMonday, vbFirstFourDays) ' Used for filtering the table
' Filtering the order database, showing only the chosen date
Lo(2).AutoFilter.ShowAllData
Lo(2).Range.AutoFilter Field:=Jj(1), Operator:=xlFilterValues, Criteria2:=Array(2, Str)
With Sh(1)
For Each Cel In Lo(2).ListColumns(Jj(2)).DataBodyRange.SpecialCells(xlCellTypeVisible)
' Transferring from the Order database
.Cells(X, Ii(1)) = dDate
.Cells(X, Ii(2)) = Cel
.Cells(X, Ii(6)) = Sh(2).Cells(Cel.Row, Jj(6))
' Find the 'ArtNo' row from the Info database
Y = Lo(3).ListColumns(Kk(2)).Find(Cel, LookIn:=xlValues, LookAt:=xlWhole).Row
' Transferring from the Info database
.Cells(X, Ii(3)) = Sh(3).Cells(Y, Kk(3))
.Cells(X, Ii(4)) = Sh(3).Cells(Y, Kk(4))
.Cells(X, Ii(5)) = Sh(3).Cells(Y, Kk(5))
' Calculating units and litres
.Cells(X, Ii(7)) = .Cells(X, Ii(6)) * .Cells(X, Ii(4))
.Cells(X, Ii(8)) = .Cells(X, Ii(6)) * .Cells(X, Ii(5))
X = X + 1
Next Cel
End With
CalcOn
End
End Sub
Function CalcOff()
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False
End Function
Function CalcOn()
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True
End Function
My question is:
Is there an easier way to transfer data like this? I'm thinking classes, but I have never worked with them so I'd really appreciate if someone could give an example of how to implement classes while doing a transfer like this one.
Please note that the code is just a quickly written example. I've placed all tables at "A1" in each sheet, otherwise I would have to do the following for each column:
Ii(1) = .ListColumns("Date").Range.Column - .Range.Column + 1
Upvotes: 1
Views: 93
Reputation: 4974
Yes. Use Microsoft Query. It does not require installation of PowerQuery as it is available just like your database link natively from Excel. Below example of transfering data between Worksheets:
SELECT * FROM [Input$] as I INNER JOIN [AnotherWorksheet$] as A ON I.ArtNo = A.ArtNo
Then update the Query from VBA:
ActiveSheet.QueryTables(1).Refresh BackgroundQuery:=False
You can create a Microsoft Query from the Data ribbon tab (From Other Sources) or using my Add-In (just for creating the query): link.
Here an example of how to use Iif to return different values based on a day of the week:
SELECT Iif( DatePart ("w", #05/07/2015#,2) = 1, 1,0) as StartMonday,
Iif( DatePart ("w", #05/07/2015#,2) = 2, 1,0) as StartTuesday,
Iif( DatePart ("w", #05/07/2015#,2) = 3, 1,0) as StartWednesday,
Iif( DatePart ("w", #05/07/2015#,2) = 4, 1,0) as StartThursday,
Iif( DatePart ("w", #05/07/2015#,2) = 5, 1,0) as StartFriday
This will return something like:
StartMonday | StartTuesday | StartWednesday | StartThursday | StartFriday
0 | 0 | 0 | 1 | 0
Upvotes: 1