VBA Macro Performance Tuning

K

Kipo

New Member
Joined
Apr 17, 2009
Messages
10
I've created a VBA macro to take data from a sharepoint list and convert it into a format where i'm able to utilise a pivot table to display the data.

The macro itself runs fine albeit a little slow and was wondering if anyone could help me perform some performance tuning, i'm not looking for someone to do it for me just a few pointers of what i should be looking at as i'll prefer to learn :)

Explanation:
Data is pulled through into 4 sheets (Iplus, RI, Docs, Compliance) via 4 workbook connections and automatically refreshes on open.
The macro then works through the 4 sheets transposing the data into a sheet called "other combined data" and adds a selection of vlookups to add some additional data (also from another sheet)
Other combined data is then used as the base for a number of pivot tables that allows the user to interrogate and manipulate the data how they see fit.

Code: 
Sub ReversePivotTable()
    
    Dim SummaryTable As Range, OutputRange As Range
    Dim OutRow As Long
    Dim r As Long, c As Long
    Dim strBar As String
    Dim lngLoop As Long
    
    On Error Resume Next
    
    With Sheets("Other Combined Data").Cells
    .Select
    .ClearContents
    End With
        
    Application.DisplayStatusBar = True
    Application.Calculation = xlCalculateManual
    
    Set SummaryTable = Sheets("Iplus").Range("A1").CurrentRegion
    SummaryTable.Select
    Set OutputRange = Sheets("Other Combined Data").Range("A1")
    OutRow = 2
    Application.StatusBar = String(2, ChrW(9609)) & "Working..."
    Application.ScreenUpdating = False
    OutputRange.Range("A1:U1") = Array("Policy", "Field", "Data", "Area", "Channel", "Month", "Name of Underwriter", "Auditor", "Type of Audit", "Product", "Unoccupied", "Transaction Type", "Category", "Result", "Year", "Quarter", "Hotspot", "Month2", "Policy Branch", "Category2", "Overall Result")
    For r = 2 To SummaryTable.Rows.Count
        For c = 2 To SummaryTable.Columns.Count
            OutputRange.Cells(OutRow, 1) = SummaryTable.Cells(r, 1)
            OutputRange.Cells(OutRow, 2) = SummaryTable.Cells(1, c)
            OutputRange.Cells(OutRow, 3).Value = SummaryTable.Cells(r, c).Value
            Select Case OutputRange.Cells(OutRow, 3)
               Case "0"
                 OutputRange.Cells(OutRow, 3) = vbNullString
               Case "00:00:00"
                 OutputRange.Cells(OutRow, 3) = vbNullString
               Case "1"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "2"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "5"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "11"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "01/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "02/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "05/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "11/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
             
            End Select
            'OutputRange.Cells(OutRow, 3).NumberFormat = SummaryTable.Cells(r, c).NumberFormat
            OutputRange.Cells(OutRow, 4) = "=VLOOKUP(RC[-3],Combined_Items,2,FALSE)" 'area
            OutputRange.Cells(OutRow, 5) = "=VLOOKUP(RC[-4],Combined_Items,3,FALSE)" 'channel
            OutputRange.Cells(OutRow, 6) = "=VLOOKUP(RC[-5],Combined_Items,6,FALSE)" 'month
            OutputRange.Cells(OutRow, 7) = "=VLOOKUP(RC[-6],Combined_Items,11,FALSE)" 'name of underwriter
            OutputRange.Cells(OutRow, 8) = "=VLOOKUP(RC[-7],Combined_Items,10,FALSE)" 'auditor
            OutputRange.Cells(OutRow, 9) = "=VLOOKUP(RC[-8],Combined_Items,14,FALSE)" 'type of audit
            OutputRange.Cells(OutRow, 10) = "=VLOOKUP(RC[-9],Combined_Items,15,FALSE)" 'product
            OutputRange.Cells(OutRow, 11) = "=VLOOKUP(RC[-10],Combined_Items,16,FALSE)" 'unoccupied
            OutputRange.Cells(OutRow, 12) = "=VLOOKUP(RC[-11],Combined_Items,17,FALSE)" 'Transaction Type
            OutputRange.Cells(OutRow, 13) = "IPlus"                                                         'Category
            OutputRange.Cells(OutRow, 14) = "=VLOOKUP(RC[-13],Combined_Items,19,FALSE)" 'Result
            OutputRange.Cells(OutRow, 15) = "=VLOOKUP(RC[-14],Combined_Items,7,FALSE)" 'year
            OutputRange.Cells(OutRow, 16) = "=VLOOKUP(RC[-15],Combined_Items,8,FALSE)" 'quarter
            OutputRange.Cells(OutRow, 17) = "=VLOOKUP(RC[-16],Combined_Items,5,FALSE)" 'hotspot
            OutputRange.Cells(OutRow, 18) = "=VLOOKUP(RC[-17],Combined_Items,20,FALSE)"  'month2
            OutputRange.Cells(OutRow, 19) = "=VLOOKUP(RC[-18],Combined_Items,12,FALSE)" 'policy branch
            OutputRange.Cells(OutRow, 20) = "IPlus"                                                         'category2
            OutputRange.Cells(OutRow, 21) = "=VLOOKUP(RC[-20],Combined_Items,25,FALSE)"
            OutRow = OutRow + 1
        Next c
    Next r
    Application.ScreenUpdating = True
        Application.StatusBar = String(4, ChrW(9609)) & "Still Working..."
    Application.ScreenUpdating = False
    Set SummaryTable = Sheets("Compliance").Range("A1").CurrentRegion
    SummaryTable.Select
    Set OutputRange = Sheets("Other Combined Data").Range("A1")
    For r = 2 To SummaryTable.Rows.Count
        For c = 25 To SummaryTable.Columns.Count
            OutputRange.Cells(OutRow, 1) = SummaryTable.Cells(r, 1)
            OutputRange.Cells(OutRow, 2) = SummaryTable.Cells(1, c)
            OutputRange.Cells(OutRow, 3).Value = SummaryTable.Cells(r, c).Value
            Select Case OutputRange.Cells(OutRow, 3)
               Case "0"
                 OutputRange.Cells(OutRow, 3) = vbNullString
               Case "00:00:00"
                 OutputRange.Cells(OutRow, 3) = vbNullString
               Case "1"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "2"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "5"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "11"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "01/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "02/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "05/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "11/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
             
            End Select
            'OutputRange.Cells(OutRow, 3).NumberFormat = SummaryTable.Cells(r, c).NumberFormat
            OutputRange.Cells(OutRow, 4) = "=VLOOKUP(RC[-3],Combined_Items,2,FALSE)" 'area
            OutputRange.Cells(OutRow, 5) = "=VLOOKUP(RC[-4],Combined_Items,3,FALSE)" 'channel
            OutputRange.Cells(OutRow, 6) = "=VLOOKUP(RC[-5],Combined_Items,6,FALSE)" 'month
            OutputRange.Cells(OutRow, 7) = "=VLOOKUP(RC[-6],Combined_Items,11,FALSE)" 'name of underwriter
            OutputRange.Cells(OutRow, 8) = "=VLOOKUP(RC[-7],Combined_Items,10,FALSE)" 'auditor
            OutputRange.Cells(OutRow, 9) = "=VLOOKUP(RC[-8],Combined_Items,14,FALSE)" 'type of audit
            OutputRange.Cells(OutRow, 10) = "=VLOOKUP(RC[-9],Combined_Items,15,FALSE)" 'product
            OutputRange.Cells(OutRow, 11) = "=VLOOKUP(RC[-10],Combined_Items,16,FALSE)" 'unoccupied
            OutputRange.Cells(OutRow, 12) = "=VLOOKUP(RC[-11],Combined_Items,17,FALSE)" 'Transaction Type
            OutputRange.Cells(OutRow, 13) = "Compliance"                                                         'Category
            OutputRange.Cells(OutRow, 14) = "=VLOOKUP(RC[-13],Combined_Items,19,FALSE)" 'Result
            OutputRange.Cells(OutRow, 15) = "=VLOOKUP(RC[-14],Combined_Items,7,FALSE)" 'year
            OutputRange.Cells(OutRow, 16) = "=VLOOKUP(RC[-15],Combined_Items,8,FALSE)" 'quarter
            OutputRange.Cells(OutRow, 17) = "=VLOOKUP(RC[-16],Combined_Items,5,FALSE)" 'hotspot
            OutputRange.Cells(OutRow, 18) = "=VLOOKUP(RC[-17],Combined_Items,20,FALSE)"  'month2
            OutputRange.Cells(OutRow, 19) = "=VLOOKUP(RC[-18],Combined_Items,12,FALSE)" 'policy branch
            OutputRange.Cells(OutRow, 20) = "Compliance"                                                    'category2
            OutputRange.Cells(OutRow, 21) = "=VLOOKUP(RC[-20],Combined_Items,25,FALSE)"
            OutRow = OutRow + 1
        Next c
    Next r
    Application.ScreenUpdating = True
        Application.StatusBar = String(6, ChrW(9609)) & "Still Working..."
    Application.ScreenUpdating = False
    Set SummaryTable = Sheets("Docs").Range("A1").CurrentRegion
    SummaryTable.Select
    Set OutputRange = Sheets("Other Combined Data").Range("A1")
    For r = 2 To SummaryTable.Rows.Count
        For c = 25 To SummaryTable.Columns.Count
            OutputRange.Cells(OutRow, 1) = SummaryTable.Cells(r, 1)
            OutputRange.Cells(OutRow, 2) = SummaryTable.Cells(1, c)
            OutputRange.Cells(OutRow, 3).Value = SummaryTable.Cells(r, c).Value
            Select Case OutputRange.Cells(OutRow, 3)
               Case "0"
                 OutputRange.Cells(OutRow, 3) = vbNullString
               Case "00:00:00"
                 OutputRange.Cells(OutRow, 3) = vbNullString
               Case "1"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "2"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "5"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "11"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "01/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "02/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "05/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "11/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
             
            End Select
            'OutputRange.Cells(OutRow, 3).NumberFormat = SummaryTable.Cells(r, c).NumberFormat
            OutputRange.Cells(OutRow, 4) = "=VLOOKUP(RC[-3],Combined_Items,2,FALSE)" 'area
            OutputRange.Cells(OutRow, 5) = "=VLOOKUP(RC[-4],Combined_Items,3,FALSE)" 'channel
            OutputRange.Cells(OutRow, 6) = "=VLOOKUP(RC[-5],Combined_Items,6,FALSE)" 'month
            OutputRange.Cells(OutRow, 7) = "=VLOOKUP(RC[-6],Combined_Items,11,FALSE)" 'name of underwriter
            OutputRange.Cells(OutRow, 8) = "=VLOOKUP(RC[-7],Combined_Items,10,FALSE)" 'auditor
            OutputRange.Cells(OutRow, 9) = "=VLOOKUP(RC[-8],Combined_Items,14,FALSE)" 'type of audit
            OutputRange.Cells(OutRow, 10) = "=VLOOKUP(RC[-9],Combined_Items,15,FALSE)" 'product
            OutputRange.Cells(OutRow, 11) = "=VLOOKUP(RC[-10],Combined_Items,16,FALSE)" 'unoccupied
            OutputRange.Cells(OutRow, 12) = "=VLOOKUP(RC[-11],Combined_Items,17,FALSE)" 'Transaction Type
            OutputRange.Cells(OutRow, 13) = "Docs"                                                         'Category
            OutputRange.Cells(OutRow, 14) = "=VLOOKUP(RC[-13],Combined_Items,19,FALSE)" 'Result
            OutputRange.Cells(OutRow, 15) = "=VLOOKUP(RC[-14],Combined_Items,7,FALSE)" 'year
            OutputRange.Cells(OutRow, 16) = "=VLOOKUP(RC[-15],Combined_Items,8,FALSE)" 'quarter
            OutputRange.Cells(OutRow, 17) = "=VLOOKUP(RC[-16],Combined_Items,5,FALSE)" 'hotspot
            OutputRange.Cells(OutRow, 18) = "=VLOOKUP(RC[-17],Combined_Items,20,FALSE)"  'month2
            OutputRange.Cells(OutRow, 19) = "=VLOOKUP(RC[-18],Combined_Items,12,FALSE)" 'policy branch
            OutputRange.Cells(OutRow, 20) = "Docs"                                                         'category2
            OutputRange.Cells(OutRow, 21) = "=VLOOKUP(RC[-20],Combined_Items,25,FALSE)"
            OutRow = OutRow + 1
        Next c
    Next r
    Application.ScreenUpdating = True
        Application.StatusBar = String(8, ChrW(9609)) & "Still Working..."
    Application.ScreenUpdating = False
    Set SummaryTable = Sheets("RI").Range("A1").CurrentRegion
    SummaryTable.Select
    Set OutputRange = Sheets("Other Combined Data").Range("A1")

    For r = 2 To SummaryTable.Rows.Count
        For c = 25 To SummaryTable.Columns.Count
            OutputRange.Cells(OutRow, 1) = SummaryTable.Cells(r, 1)
            OutputRange.Cells(OutRow, 2) = SummaryTable.Cells(1, c)
            OutputRange.Cells(OutRow, 3).Value = SummaryTable.Cells(r, c).Value
            Select Case OutputRange.Cells(OutRow, 3)
               Case "0"
                 OutputRange.Cells(OutRow, 3) = vbNullString
               Case "00:00:00"
                 OutputRange.Cells(OutRow, 3) = vbNullString
               Case "1"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "2"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "5"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "11"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "01/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "02/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "05/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
               Case "11/01/1900"
                 OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
             
            End Select         'OutputRange.Cells(OutRow, 3).NumberFormat = SummaryTable.Cells(r, c).NumberFormat
            OutputRange.Cells(OutRow, 4) = "=VLOOKUP(RC[-3],Combined_Items,2,FALSE)" 'area
            OutputRange.Cells(OutRow, 5) = Format("=VLOOKUP(RC[-4],Combined_Items,3,FALSE)", "General Number") 'channel
            OutputRange.Cells(OutRow, 6) = "=VLOOKUP(RC[-5],Combined_Items,6,FALSE)" 'month
            OutputRange.Cells(OutRow, 7) = "=VLOOKUP(RC[-6],Combined_Items,11,FALSE)" 'name of underwriter
            OutputRange.Cells(OutRow, 8) = "=VLOOKUP(RC[-7],Combined_Items,10,FALSE)" 'auditor
            OutputRange.Cells(OutRow, 9) = "=VLOOKUP(RC[-8],Combined_Items,14,FALSE)" 'type of audit
            OutputRange.Cells(OutRow, 10) = "=VLOOKUP(RC[-9],Combined_Items,15,FALSE)" 'product
            OutputRange.Cells(OutRow, 11) = "=VLOOKUP(RC[-10],Combined_Items,16,FALSE)" 'unoccupied
            OutputRange.Cells(OutRow, 12) = "=VLOOKUP(RC[-11],Combined_Items,17,FALSE)" 'Transaction Type
            OutputRange.Cells(OutRow, 13) = "RI"                                                         'Category
            OutputRange.Cells(OutRow, 14) = "=VLOOKUP(RC[-13],Combined_Items,19,FALSE)" 'Result
            OutputRange.Cells(OutRow, 15) = "=VLOOKUP(RC[-14],Combined_Items,7,FALSE)" 'year
            OutputRange.Cells(OutRow, 16) = "=VLOOKUP(RC[-15],Combined_Items,8,FALSE)" 'quarter
            OutputRange.Cells(OutRow, 17) = "=VLOOKUP(RC[-16],Combined_Items,5,FALSE)" 'hotspot
            OutputRange.Cells(OutRow, 18) = "=VLOOKUP(RC[-17],Combined_Items,20,FALSE)"  'month2
            OutputRange.Cells(OutRow, 19) = "=VLOOKUP(RC[-18],Combined_Items,12,FALSE)" 'policy branch
            OutputRange.Cells(OutRow, 20) = "RI"                                                         'category2
            OutputRange.Cells(OutRow, 21) = "=VLOOKUP(RC[-20],Combined_Items,25,FALSE)"
            OutRow = OutRow + 1
        Next c
    Next r
    Application.ScreenUpdating = True
Application.StatusBar = String(10, ChrW(9609)) & "Almost Done..."
    Application.ScreenUpdating = False
  

Application.StatusBar = False
   'Application.ScreenUpdating = True
   Application.Calculation = xlAutomatic
   
End Sub

TIA Kipo :-)
 
Sort by date Sort by votes
Hi Kipo,

Here's a few suggestions and comments....
1. Stepping through each row and processing it separately is a relatively slow technique. Faster alternatives are:
Applying R1C1 formulas to all your Rows at once;
Reading your data into an array in one step, processing the array in VBA; then writing the results back in one step.

2. Using a query to merge your data would probably be the fastest overall approach. I haven't studied your code well enough to be sure that's a good fit, but it appears to be largely database processing steps (lookup, union, join).

3. You don't need to Select or Activate objects except in rare cases. It's more efficient just to reference them.

4. I think you have a typo here... xlCalculateManual should be xlCalculationManual (this might have prevented Calculation from being temporarily set to manual).

5. Avoid setting the Error Handler to "On Error Resume Next" for more lines of code than is necessary. This will tend to mask errors that otherwise would pop up in the Debugger or custom error handler that displays an alert. (like the typo in comment #4).


These two comments won't have much impact on speed, but they will make your code easier to follow and maintain:

6. When using Select Case, you can combine Cases together that result in the same action.


Code: 
Select Case OutputRange.Cells(OutRow, 3)
    Case "0", "00:00:00"
        OutputRange.Cells(OutRow, 3) = vbNullString
    Case "1", "2", "5", "11", "01/01/1900", "02/01/1900", "05/01/1900", "11/01/1900"
        OutputRange.Cells(OutRow, 3) = CInt(OutputRange.Cells(OutRow, 3))
    Case Else 
        '---what to do if no other criteria met?
End Select

7. Instead of repeating blocks of code for each of the 4 sheets, use a function call. You can pass arguments like the sheet object or sheet name to that single function and have it process that sheet.

Just ask if any of that isn't clear or if you would like help implementing any of the suggestions.
 
Upvote 0
Jerry,

Thanks for the quick and informative reply, i'm honoured to have a MVP help me out! Unfortunately I haven't had much chance to work on this today apart from changing the case statement as per your suggestion, which works fine and is much easier to read!

I would like to learn more about using arrays as i've read that they are very effective at working with large data sets quickly, could you recommend any links for me to visit on this subject?
 
Upvote 0
Kipo, Here are two links that might help you get started learning about Arrays.

Understanding Arrays

VBA Arrays

The second link is more advanced and includes a library of interelated functions.
For now, just reading the opening few paragraphs should help you get introduced.
 
Upvote 0
Jerry,

Thanks again for the info, I've had chance to clean up my code and have tried (quite unsucessfully) to speed up the vlookup sections of my macros as these take about 90% of the total running time to complete.

I hate to ask as i feel quite defeated by this but is there any chance i could ask you to help me create some more efficient vlookups based on a sorted array?

Code: 
Sub ReversePivotTable23455()
  
    Dim SummaryTable As Range, OutputRange As Range
    Dim outrow As Long
    Dim r As Long, c As Long
   
    With Sheets("Other Combined Data").Cells
        .ClearContents
    End With
    
    Set SummaryTable = Sheets("IPlus").Range("A1").CurrentRegion
    Set OutputRange = Sheets("Other Combined Data").Range("A1")
    
    outrow = 2
       
    OutputRange.Range("A1:U1") = Array("Policy", "Field", "Data", "Area", "Channel", "Month", "Name of Underwriter", "Auditor", "Type of Audit", "Product", "Unoccupied", "Transaction Type", "Category", "Result", "Year", "Quarter", "Hotspot", "Month2", "Policy Branch", "Category2", "Overall Result")
    
    For r = 2 To SummaryTable.Rows.Count
        For c = 2 To SummaryTable.Columns.Count
    
    With OutputRange
        .Cells(outrow, 1) = SummaryTable.Cells(r, 1)
        .Cells(outrow, 2) = SummaryTable.Cells(1, c)
    End With
    
    Select Case OutputRange.Cells(outrow, 3)
        Case "0", "00:00:00", "00/01/1900"
            OutputRange.Cells(outrow, 3) = "0" 'vbNullString
        Case "1", "2", "5", "11", "01/01/1900", "02/01/1900", "05/01/1900", "11/01/1900"
            OutputRange.Cells(outrow, 3) = CInt(OutputRange.Cells(outrow, 3))
        Case Else
            OutputRange.Cells(outrow, 3).Value = SummaryTable.Cells(r, c).Value
    End Select
    
    
    With OutputRange
        .Cells(outrow, 4) = "=VLOOKUP(RC[-3],Combined_Items,2,FALSE)" 'area
        .Cells(outrow, 5) = "=VLOOKUP(RC[-4],Combined_Items,3,FALSE)" 'channel
        .Cells(outrow, 6) = "=VLOOKUP(RC[-5],Combined_Items,6,FALSE)" 'month
        .Cells(outrow, 7) = "=VLOOKUP(RC[-6],Combined_Items,11,FALSE)" 'name of underwriter
        .Cells(outrow, 8) = "=VLOOKUP(RC[-7],Combined_Items,10,FALSE)" 'auditor
        .Cells(outrow, 9) = "=VLOOKUP(RC[-8],Combined_Items,14,FALSE)" 'type of audit
        .Cells(outrow, 10) = "=VLOOKUP(RC[-9],Combined_Items,15,FALSE)" 'product
        .Cells(outrow, 11) = "=VLOOKUP(RC[-10],Combined_Items,16,FALSE)" 'unoccupied
        .Cells(outrow, 12) = "=VLOOKUP(RC[-11],Combined_Items,17,FALSE)" 'Transaction Type
        .Cells(outrow, 13) = "IPlus"                                                         'Category
        .Cells(outrow, 14) = "=VLOOKUP(RC[-13],Combined_Items,19,FALSE)" 'Result
        .Cells(outrow, 15) = "=VLOOKUP(RC[-14],Combined_Items,7,FALSE)" 'year
        .Cells(outrow, 16) = "=VLOOKUP(RC[-15],Combined_Items,8,FALSE)" 'quarter
        .Cells(outrow, 17) = "=VLOOKUP(RC[-16],Combined_Items,5,FALSE)" 'hotspot
        .Cells(outrow, 18) = "=RC[-12]"  'month2
        .Cells(outrow, 19) = "=VLOOKUP(RC[-18],Combined_Items,12,FALSE)" 'policy branch
        .Cells(outrow, 20) = "IPlus"                                                         'category2
        .Cells(outrow, 21) = "=VLOOKUP(RC[-20],Combined_Items,25,FALSE)"
    End With
    outrow = outrow + 1
        Next c
    Next r
    
    Set SummaryTable = Sheets("Compliance").Range("A1").CurrentRegion
    Set OutputRange = Sheets("Other Combined Data").Range("A1")
    For r = 2 To SummaryTable.Rows.Count
        For c = 25 To SummaryTable.Columns.Count
        
    With OutputRange
        .Cells(outrow, 1) = SummaryTable.Cells(r, 1)
        .Cells(outrow, 2) = SummaryTable.Cells(1, c)
    End With
   
    Select Case OutputRange.Cells(outrow, 3)
        Case "0", "00:00:00", "00/01/1900"
            OutputRange.Cells(outrow, 3) = "0"
        Case "1", "2", "5", "11", "01/01/1900", "02/01/1900", "05/01/1900", "11/01/1900"
            OutputRange.Cells(outrow, 3) = CInt(OutputRange.Cells(outrow, 3))
        Case Else
            OutputRange.Cells(outrow, 3).Value = SummaryTable.Cells(r, c).Value
    End Select
    
    With OutputRange
        .Cells(outrow, 4) = "=VLOOKUP(RC[-3],Combined_Items,2,FALSE)" 'area
        .Cells(outrow, 5) = "=VLOOKUP(RC[-4],Combined_Items,3,FALSE)" 'channel
        .Cells(outrow, 6) = "=VLOOKUP(RC[-5],Combined_Items,6,FALSE)" 'month
        .Cells(outrow, 7) = "=VLOOKUP(RC[-6],Combined_Items,11,FALSE)" 'name of underwriter
        .Cells(outrow, 8) = "=VLOOKUP(RC[-7],Combined_Items,10,FALSE)" 'auditor
        .Cells(outrow, 9) = "=VLOOKUP(RC[-8],Combined_Items,14,FALSE)" 'type of audit
        .Cells(outrow, 10) = "=VLOOKUP(RC[-9],Combined_Items,15,FALSE)" 'product
        .Cells(outrow, 11) = "=VLOOKUP(RC[-10],Combined_Items,16,FALSE)" 'unoccupied
        .Cells(outrow, 12) = "=VLOOKUP(RC[-11],Combined_Items,17,FALSE)" 'Transaction Type
        .Cells(outrow, 13) = "Compliance"                                                         'Category
        .Cells(outrow, 14) = "=VLOOKUP(RC[-13],Combined_Items,19,FALSE)" 'Result
        .Cells(outrow, 15) = "=VLOOKUP(RC[-14],Combined_Items,7,FALSE)" 'year
        .Cells(outrow, 16) = "=VLOOKUP(RC[-15],Combined_Items,8,FALSE)" 'quarter
        .Cells(outrow, 17) = "=VLOOKUP(RC[-16],Combined_Items,5,FALSE)" 'hotspot
        .Cells(outrow, 18) = "=RC[-12]"  'month2
        .Cells(outrow, 19) = "=VLOOKUP(RC[-18],Combined_Items,12,FALSE)" 'policy branch
        .Cells(outrow, 20) = "Compliance"                                                    'category2
        .Cells(outrow, 21) = "=VLOOKUP(RC[-20],Combined_Items,25,FALSE)"
    End With
    outrow = outrow + 1
        Next c
    Next r
    Set SummaryTable = Sheets("Docs").Range("A1").CurrentRegion
    Set OutputRange = Sheets("Other Combined Data").Range("A1")
    For r = 2 To SummaryTable.Rows.Count
        For c = 25 To SummaryTable.Columns.Count
        
    With OutputRange
        .Cells(outrow, 1) = SummaryTable.Cells(r, 1)
        .Cells(outrow, 2) = SummaryTable.Cells(1, c)
    End With
    
    Select Case OutputRange.Cells(outrow, 3)
        Case "0", "00:00:00", "00/01/1900"
            OutputRange.Cells(outrow, 3) = vbNullString
        Case "1", "2", "5", "11", "01/01/1900", "02/01/1900", "05/01/1900", "11/01/1900"
            OutputRange.Cells(outrow, 3) = CInt(OutputRange.Cells(outrow, 3))
        Case Else
            OutputRange.Cells(outrow, 3).Value = SummaryTable.Cells(r, c).Value
    End Select
    
    With OutputRange
        .Cells(outrow, 4) = "=VLOOKUP(RC[-3],Combined_Items,2,FALSE)" 'area
        .Cells(outrow, 5) = "=VLOOKUP(RC[-4],Combined_Items,3,FALSE)" 'channel
        .Cells(outrow, 6) = "=VLOOKUP(RC[-5],Combined_Items,6,FALSE)" 'month
        .Cells(outrow, 7) = "=VLOOKUP(RC[-6],Combined_Items,11,FALSE)" 'name of underwriter
        .Cells(outrow, 8) = "=VLOOKUP(RC[-7],Combined_Items,10,FALSE)" 'auditor
        .Cells(outrow, 9) = "=VLOOKUP(RC[-8],Combined_Items,14,FALSE)" 'type of audit
        .Cells(outrow, 10) = "=VLOOKUP(RC[-9],Combined_Items,15,FALSE)" 'product
        .Cells(outrow, 11) = "=VLOOKUP(RC[-10],Combined_Items,16,FALSE)" 'unoccupied
        .Cells(outrow, 12) = "=VLOOKUP(RC[-11],Combined_Items,17,FALSE)" 'Transaction Type
        .Cells(outrow, 13) = "Docs"                                      'Category
        .Cells(outrow, 14) = "=VLOOKUP(RC[-13],Combined_Items,19,FALSE)" 'Result
        .Cells(outrow, 15) = "=VLOOKUP(RC[-14],Combined_Items,7,FALSE)" 'year
        .Cells(outrow, 16) = "=VLOOKUP(RC[-15],Combined_Items,8,FALSE)" 'quarter
        .Cells(outrow, 17) = "=VLOOKUP(RC[-16],Combined_Items,5,FALSE)" 'hotspot
        .Cells(outrow, 18) = "=RC[-12]"  'month2
        .Cells(outrow, 19) = "=VLOOKUP(RC[-18],Combined_Items,12,FALSE)" 'policy branch
        .Cells(outrow, 20) = "Docs"                                      'category2
        .Cells(outrow, 21) = "=VLOOKUP(RC[-20],Combined_Items,25,FALSE)"
    End With
    outrow = outrow + 1
        Next c
    Next r
    Set SummaryTable = Sheets("RI").Range("A1").CurrentRegion
    Set OutputRange = Sheets("Other Combined Data").Range("A1")
    For r = 2 To SummaryTable.Rows.Count
    For c = 25 To SummaryTable.Columns.Count
    
    With OutputRange
        .Cells(outrow, 1) = SummaryTable.Cells(r, 1)
        .Cells(outrow, 2) = SummaryTable.Cells(1, c)
    End With
    
    Select Case OutputRange.Cells(outrow, 3)
        Case "0", "00:00:00", "00/01/1900"
            OutputRange.Cells(outrow, 3) = vbNullString
        Case "1", "2", "5", "11", "01/01/1900", "02/01/1900", "05/01/1900", "11/01/1900"
            OutputRange.Cells(outrow, 3) = CInt(OutputRange.Cells(outrow, 3))
        Case Else
            OutputRange.Cells(outrow, 3).Value = SummaryTable.Cells(r, c).Value
    End Select
 
    With OutputRange
        .Cells(outrow, 4) = "=VLOOKUP(RC[-3],Combined_Items,2,FALSE)" 'area
        .Cells(outrow, 5) = Format("=VLOOKUP(RC[-4],Combined_Items,3,FALSE)", "General Number") 'channel
        .Cells(outrow, 6) = "=VLOOKUP(RC[-5],Combined_Items,6,FALSE)" 'month
        .Cells(outrow, 7) = "=VLOOKUP(RC[-6],Combined_Items,11,FALSE)" 'name of underwriter
        .Cells(outrow, 8) = "=VLOOKUP(RC[-7],Combined_Items,10,FALSE)" 'auditor
        .Cells(outrow, 9) = "=VLOOKUP(RC[-8],Combined_Items,14,FALSE)" 'type of audit
        .Cells(outrow, 10) = "=VLOOKUP(RC[-9],Combined_Items,15,FALSE)" 'product
        .Cells(outrow, 11) = "=VLOOKUP(RC[-10],Combined_Items,16,FALSE)" 'unoccupied
        .Cells(outrow, 12) = "=VLOOKUP(RC[-11],Combined_Items,17,FALSE)" 'Transaction Type
        .Cells(outrow, 13) = "RI"                                                         'Category
        .Cells(outrow, 14) = "=VLOOKUP(RC[-13],Combined_Items,19,FALSE)" 'Result
        .Cells(outrow, 15) = "=VLOOKUP(RC[-14],Combined_Items,7,FALSE)" 'year
        .Cells(outrow, 16) = "=VLOOKUP(RC[-15],Combined_Items,8,FALSE)" 'quarter
        .Cells(outrow, 17) = "=VLOOKUP(RC[-16],Combined_Items,5,FALSE)" 'hotspot
        .Cells(outrow, 18) = "=RC[-12]"  'month2
        .Cells(outrow, 19) = "=VLOOKUP(RC[-18],Combined_Items,12,FALSE)" 'policy branch
        .Cells(outrow, 20) = "RI"                                                         'category2
        .Cells(outrow, 21) = "=VLOOKUP(RC[-20],Combined_Items,25,FALSE)"
    End With
    outrow = outrow + 1
        Next c
    Next r
End Sub

TIA Kipo :-)
 
Last edited:
Upvote 0
Hi Kipo,

I'm happy to help you. :)
Don't feel discouraged - your VBA will improve with practice, and you can learn more when something doesn't work initially than when you get lucky and it does.

Approximately what size (rows x columns) are each of your SummaryTable ranges and your Combined_Items range?

Approximately how long does it take to run your macro for that size of datasets?

Currently, there are Vlookup formulas left in the Output Table after the macro is run.
Could those be values instead of formulas? Presumably upon updating your SummaryTables you would run your macro again to get the latest list of Policy items, so retaining the formulas wouldn't seem necessary.
 
Upvote 0
You must log in or register to reply here.

Similar threads

D
  • Solved
VBA to generate report
2
Replies
15
Views
296
dsubash
D
Guna13
  • Question Question
Help to Optimize Macro Code for Faster Performance
Replies
0
Views
1K
Guna13
Guna13
D
  • Question Question
Problems Encountered When Generating VBA Excel Charts with 15-Minute Interval Data.
Replies
0
Views
404
dilshod_k
D
V
  • Question Question
VBA macro works fine when stepping through (F8), but won't run correctly(F5)
Replies
2
Views
1K
VenkateshRajaganesan
V
1
  • Question Question
Auto filter column on vlookup update on every sheets of the workbook
Replies
1
Views
533
10ml
1

Share this page

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