TAKL
TAKL

Reputation: 339

Best way to store rows/columns from sheets/tables?

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

Answers (1)

AnalystCave.com
AnalystCave.com

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

Related Questions