Building a new Excel sheet from queries on existing sheets

Question

This code runs a number of queries on various sheets, copies the table values to new sheets for manipulation such as sorting and summing, and finally builds a template sheet from the newly manipulated results. In doing so I find there is a lot of redundant code which I think could be streamlined but I'm not sure.

I'm self taught and hoping that people with more experience and knowledge can look over the following code and provide me with some pointers to optimize and streamline the process. Things such as 'rather than rebuild the arrays why don't you create global arrays', or 'you're really not accomplishing anything with that lastRow function'...

Sub Refresh() 'Clear previous queries and results sets
 Dim DataSh, ResultsSh As Worksheet
 'Show wait screen
 UserForm1.Show vbModeless
 Application.Wait (Now + TimeValue("00:00:01"))
 With Application
 .DisplayAlerts = False
 .EnableEvents = False
 .ScreenUpdating = False
 End With
 'Refresh the query sheets
 For Each DataSh In Sheets(Array("DP-CustomerDates", "DP-FirstDeliveries", "DP-SalesW1", "DP-SalesW2", _
 "DP-SalesW3", "DP-SalesW4", "DP-SalesW5", "DP-SalesW6", "DP-SalesW7", "DP-SalesW8", "DP-SalesW9", _
 "DP-SalesW10", "DP-SalesW11", "DP-SalesW12", "DP-SalesW13", "DP-SalesW14", "DP-SalesW15"))
 DataSh.Select
 Rows.Hidden = False
 With ActiveSheet
 .Rows("2:" & .Rows.Count).Select
 Selection.ClearContents
 End With
 Range("A1").Select
 Selection.ListObject.QueryTable.Refresh BackgroundQuery:=False
 Next
 'Remove previous results
 For Each ResultsSh In Sheets(Array("CustomerDates", "FirstDeliveries", "SalesW1", "SalesW2", _
 "SalesW3", "SalesW4", "SalesW5", "SalesW6", "SalesW7", "SalesW8", "SalesW9", "SalesW10", _
 "SalesW11", "SalesW12", "SalesW13", "SalesW14", "SalesW15"))
 ResultsSh.Select
 'Clear old result set from array
 Rows.Hidden = False
 With ActiveSheet
 .Columns("A:AX").Select
 Selection.Delete Shift:=xlToLeft
 End With
 'Selection.RemoveSubtotal
 Range("A1").Select
 Next
 'Remove previous template results
 Worksheets("Commission Report Template").Select
 If lastRow > 4 Then
 Range("A5:C" & lastRow).Delete Shift:=xlUp
 Range("D4:P" & lastRow).Delete Shift:=xlUp
 Range("Q5:S" & lastRow).Delete Shift:=xlUp
 Else
 End If
 Call CopyResults
End Sub
Sub CopyResults()
 Dim A, B
 Dim i As Integer
 Dim srcRng, destRng As Range
 'Copy DP-CustomerDates
 Sheets("DP-CustomerDates").Select
 Range("A1:D" & lastRow).Select
 Selection.Copy
 'Paste customer dates
 Sheets("CustomerDates").Select
 Range("A1").Select
 Selection.PasteSpecial Paste:=xlPasteValues
 'Copy DP-FirstDeliveries
 Sheets("DP-FirstDeliveries").Select
 Range("A1:C" & lastRow).Select
 Selection.Copy
 'Paste first deliveries
 Sheets("FirstDeliveries").Select
 Range("A1").Select
 Selection.PasteSpecial Paste:=xlPasteValues
 'Set arrays for source and destination sheets
 A = Array("DP-SalesW1", "DP-SalesW2", "DP-SalesW3", "DP-SalesW4", "DP-SalesW5", "DP-SalesW6", "DP-SalesW7", _
 "DP-SalesW8", "DP-SalesW9", "DP-SalesW10", "DP-SalesW11", "DP-SalesW12", "DP-SalesW13", "DP-SalesW14", "DP-SalesW15")
 B = Array("SalesW1", "SalesW2", "SalesW3", "SalesW4", "SalesW5", "SalesW6", "SalesW7", "SalesW8", "SalesW9", _
 "SalesW10", "SalesW11", "SalesW12", "SalesW13", "SalesW14", "SalesW15")
 For i = LBound(A) To UBound(A)
 Set srcRng = Worksheets(A(i)).UsedRange
 srcRng.Copy
 Set destRng = Worksheets(B(i)).Range("A1")
 destRng.PasteSpecial Paste:=xlPasteValues
 Next
 Call CustomerDates
End Sub
Sub CustomerDates()
 Worksheets("CustomerDates").Select
 'Set header for column E
 Range("E1").Formula = "Weeks"
 'Calculate number of weeks
 Range("E2:E" & lastRow).Formula = "=ROUNDDOWN((TODAY()-WEEKDAY(TODAY(),2)-C2)/7,0)+1"
 'Set header for column F
 Range("F1").Formula = "New Customers"
 'If customer is less than 14 weeks copy the name for the template
 Range("F2:F" & lastRow) = Evaluate("IF(E2:E" & lastRow & " < 14,B2:B" & lastRow & ","""")")
 'Add Named Range
 'Sheets("FirstDeliveries").Select
 Columns("B:E").Select
 Range("E1").Activate
 ActiveWorkbook.Names.Add Name:="CustomerDates", RefersToR1C1:="='CustomerDates'!C2:C5"
 Call FirstDeliveries
End Sub
Sub FirstDeliveries()
 Worksheets("FirstDeliveries").Select
 'Remove all but the first deliveries
 'Based on sort order
 Application.CutCopyMode = False
 ActiveSheet.Range("A1:C" & lastRow).RemoveDuplicates Columns:=1, Header:=xlYes
 'Week ending calculation
 Range("D1").Formula = "Week Ending"
 Range("D2:D" & lastRow).Formula = "=B2-WEEKDAY(B2,2)+7"
 'Add Named Range
 Sheets("FirstDeliveries").Select
 Columns("A:D").Select
 Range("D1").Activate
 ActiveWorkbook.Names.Add Name:="FirstDelivery", RefersToR1C1:="='FirstDeliveries'!C1:C4"
 Call SalesTotals
End Sub
Sub SalesTotals() 'Setup result sets with subtotals
 Dim ValueSh, salesSh As Worksheet
 'Subtotal sales
 For Each salesSh In Sheets(Array("SalesW1", "SalesW2", "SalesW3", "SalesW4", "SalesW5", "SalesW6", "SalesW7", _
 "SalesW8", "SalesW9", "SalesW10", "SalesW11", "SalesW12", "SalesW13", "SalesW14", "SalesW15"))
 salesSh.Select
 'Subtotal
 On Error Resume Next
 'Add column heading
 Range("AX1").Select
 ActiveCell.Formula = "Sales"
 'Sum each row and fill down
 Range("AX2").Select
 ActiveCell.Formula = "=SUM(B2:AB2)-SUM(AC2:AW2)"
 Range("AX2:AX" & lastRow).FillDown
 'Remove formulas
 Range("AX2:AX" & lastRow).Select
 Selection.Copy
 Selection.PasteSpecial Paste:=xlPasteValues
 'Remove details
 Columns("B:AW").Select
 Selection.EntireColumn.Delete
 Range("A1").Select
 Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
 Replace:=True, PageBreaks:=False, SummaryBelowData:=True
 'Remove subtotal formulas
 Range("B2:B" & lastRow + 1).Select
 Selection.Copy
 Selection.PasteSpecial Paste:=xlPasteValues
 'View Totals
 ActiveSheet.Outline.ShowLevels RowLevels:=2
 Range("A1").Select
 'Remove "Total"
 With Range("A:A")
 .Replace What:=" Total", Replacement:="", LookAt:=xlPart, _
 SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
 ReplaceFormat:=False
 End With
 Next
 Call DeleteHiddenRows
End Sub
Sub DeleteHiddenRows()
 Dim rngHidden As Range
 Dim Sh As Worksheet
 'Create the sheets array.
 For Each Sh In Sheets(Array("SalesW1", "SalesW2", "SalesW3", "SalesW4", "SalesW5", "SalesW6", "SalesW7", _
 "SalesW8", "SalesW9", "SalesW10", "SalesW11", "SalesW12", "SalesW13", "SalesW14", "SalesW15"))
 Sh.Select
 'Error handler for case: No hidden cells
 On Error Resume Next ' In case there's no hidden cells
 Range("A1").Select
 'Delete hidden cells
 With Cells
 Set rngHidden = .SpecialCells(xlCellTypeVisible)
 .EntireRow.Hidden = False 'Unhide all cells
 rngHidden.EntireRow.Hidden = True 'Hide previously visible cells
 .SpecialCells(xlCellTypeVisible).EntireRow.Delete 'Delete previously hidden cells
 rngHidden.EntireRow.Hidden = False 'Unhide previously visible cells
 End With
 Application.CutCopyMode = False
 Selection.RemoveSubtotal
 Next
 'Add Named Range
 Sheets("SalesW1").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW1", RefersToR1C1:="='SalesW1'!C1:C2"
 Sheets("SalesW2").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW2", RefersToR1C1:="='SalesW2'!C1:C2"
 Sheets("SalesW3").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW3", RefersToR1C1:="='SalesW3'!C1:C2"
 Sheets("SalesW4").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW4", RefersToR1C1:="='SalesW4'!C1:C2"
 Sheets("SalesW5").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW5", RefersToR1C1:="='SalesW5'!C1:C2"
 Sheets("SalesW6").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW6", RefersToR1C1:="='SalesW6'!C1:C2"
 Sheets("SalesW7").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW7", RefersToR1C1:="='SalesW7'!C1:C2"
 Sheets("SalesW8").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW8", RefersToR1C1:="='SalesW8'!C1:C2"
 Sheets("SalesW9").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW9", RefersToR1C1:="='SalesW9'!C1:C2"
 Sheets("SalesW10").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW10", RefersToR1C1:="='SalesW10'!C1:C2"
 Sheets("SalesW11").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW11", RefersToR1C1:="='SalesW11'!C1:C2"
 Sheets("SalesW12").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW12", RefersToR1C1:="='SalesW12'!C1:C2"
 Sheets("SalesW13").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW13", RefersToR1C1:="='SalesW13'!C1:C2"
 Sheets("SalesW14").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW14", RefersToR1C1:="='SalesW14'!C1:C2"
 Sheets("SalesW15").Select
 Columns("A:B").Select
 Range("B1").Activate
 ActiveWorkbook.Names.Add Name:="SalesW15", RefersToR1C1:="='SalesW15'!C1:C2"
 Call BuildCommissions
End Sub
Sub BuildCommissions()
 Dim ws As Worksheet
 Dim i As Integer
 Dim lRow As Long
 'Select the sheet and set ws
 Worksheets("CustomerDates").Select
 Set ws = ActiveSheet
 'Find last row column F
 With ws
 lRow = .Cells(.Rows.Count, "F").End(xlUp).Row
 End With
 'Copy
 Range("F2:F" & lRow).Select
 Selection.Copy
 'Select template, paste values
 Worksheets("Commission Report Template").Select
 Range("B5").PasteSpecial Paste:=xlPasteValues
 'Find last row column B
 With ActiveSheet
 lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
 End With
 'Lookup first deliveries
 Range("A5:A" & lRow).Formula = "=VLOOKUP(B5,FirstDelivery,4,FALSE)"
 'Remove formulas
 Range("A5:A" & lRow).Select
 Selection.Copy
 Selection.PasteSpecial Paste:=xlPasteValues
 'Add week ending dates
 Range("D4:P4").Formula = "=Parameters!B3"
 'Remove formulas
 Range("A5:A" & lRow).Select
 Selection.Copy
 Selection.PasteSpecial Paste:=xlPasteValues
 'Formats
 Range("D4:P4").Select
 With Selection
 .HorizontalAlignment = xlCenter
 End With
 Selection.Font.Bold = True
 'If start week is #N/A remove the row
 For i = 5 To Range("A" & "65536").End(xlUp).Row Step 1
 If Application.WorksheetFunction.CountIf(Range("A" & i), "#N/A") = 1 Then
 Range("A" & i).EntireRow.Delete
 End If
 Next i
 'Find new last row
 With ActiveSheet
 lRow = .Cells(.Rows.Count, "B").End(xlUp).Row
 End With
 'Add formulas for weekly sales
 Range("D5:D" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW1,2,FALSE)),""0"",VLOOKUP(B5,SalesW1,2,FALSE))"
 Range("E5:E" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW2,2,FALSE)),""0"",VLOOKUP(B5,SalesW2,2,FALSE))"
 Range("F5:F" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW3,2,FALSE)),""0"",VLOOKUP(B5,SalesW3,2,FALSE))"
 Range("G5:G" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW4,2,FALSE)),""0"",VLOOKUP(B5,SalesW4,2,FALSE))"
 Range("H5:H" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW5,2,FALSE)),""0"",VLOOKUP(B5,SalesW5,2,FALSE))"
 Range("I5:I" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW6,2,FALSE)),""0"",VLOOKUP(B5,SalesW6,2,FALSE))"
 Range("J5:J" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW7,2,FALSE)),""0"",VLOOKUP(B5,SalesW7,2,FALSE))"
 Range("K5:K" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW8,2,FALSE)),""0"",VLOOKUP(B5,SalesW8,2,FALSE))"
 Range("L5:L" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW9,2,FALSE)),""0"",VLOOKUP(B5,SalesW9,2,FALSE))"
 Range("M5:M" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW10,2,FALSE)),""0"",VLOOKUP(B5,SalesW10,2,FALSE))"
 Range("N5:N" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW11,2,FALSE)),""0"",VLOOKUP(B5,SalesW11,2,FALSE))"
 Range("O5:O" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW12,2,FALSE)),""0"",VLOOKUP(B5,SalesW12,2,FALSE))"
 Range("P5:P" & lRow).Formula = "=IF(ISERROR(VLOOKUP(B5,SalesW13,2,FALSE)),""0"",VLOOKUP(B5,SalesW13,2,FALSE))"
 'Add formulas for averages and totals
 Range("Q5:Q" & lRow).Formula = "=IF(ISERROR(AVERAGE(B5:P5)),"""",AVERAGE(B5:P5))"
 Range("R5:R" & lRow).Formula = "=SUM(B5:P5)"
 Range("S5:S" & lRow).Formula = "=IF(VLOOKUP(B5,CustomerDates,3,FALSE)=0,""A"",""Q"")"
 'Remove formulas
 Range("D4:S" & lRow).Select
 Selection.Copy
 Selection.PasteSpecial Paste:=xlPasteValues
 'Remove 0ドル and not null cells
 Range("D5:P65536").Replace What:=0, LookAt:=xlWhole, Replacement:=""
 'Sort
 Range("A5:S" & lRow).Select
 ActiveWorkbook.Worksheets("Commission Report Template").Sort.SortFields.Clear
 ActiveWorkbook.Worksheets("Commission Report Template").Sort.SortFields.Add _
 Key:=Range("A5"), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption _
 :=xlSortTextAsNumbers
 With ActiveWorkbook.Worksheets("Commission Report Template").Sort
 .SetRange Range("A5:S" & lRow)
 .Header = xlNo
 .MatchCase = False
 .Orientation = xlTopToBottom
 .SortMethod = xlPinYin
 .Apply
 End With
 Application.CutCopyMode = False
 Range("A3").Select
 With Application
 .DisplayAlerts = True
 .EnableEvents = True
 .ScreenUpdating = True
 End With
 Unload UserForm1
 OutPut = MsgBox("Report completed successfully.", vbInformation, "Awesome!")
End Sub
Function lastRow()
 With ActiveSheet
 lastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
 End With
End Function

• Toby Speight: Welcome to Code Review! This question is incomplete. To help reviewers give you better answers, please add sufficient context to your question. The more you tell us about what your code does and what the purpose of doing that is, the easier it will be for reviewers to help you. The current title states your concerns about the code; it needs an edit to simply state the task; see How to get the best value out of Code Review: Asking Questions for guidance on writing good question titles.
• user109261: You should probably start by watching this video: Excel VBA Introduction Part 5 - Selecting Cells (Range, Cells, Activecell, End, Offset) and then continue watching the rest of the series.

Answer 1

I'm just going to take a stab at some of the obvious as this is my first review here.

• How to avoid using Select

  Select and Active(Sheet/Workbook/etc) are very fickle instructions for VBA to understand. They will default to whatever workbook/sheet was last acted on, and as we all know from our debugging adventures, that can vary depending on the time of day and position of the moon.

  Instead of relying on something that changes, try creating and using variables to store locations/information/directions. One of the first things I always do is set the workbook and worksheet I'm working on. For a brief example:

  Dim wbSourceData as workbook, wsSalesData as worksheet
  Set wbSourceData = ThisWorkbook
  Set wsSalesData = wbSourceData.Sheets(1)
  

  Now the workbook that holds the macro and the sheet that holds your data are locked into that variable. You don't need to keep typing 'ActiveWorkbook' or 'ActiveWorksheet' over and over again to access your data. Setting workbooks and worksheets also greatly assist in referring to ranges and performing actions on data.

• Making the most of your variables

  Variables exist so that you don't have to retype the same things over and over again. I see that you have a few instances where you have essentially re-declared variables such as:

  'Remove previous results
  For Each ResultsSh In Sheets(Array("CustomerDates", "FirstDeliveries", "SalesW1", "SalesW2", _
   "SalesW3", "SalesW4", "SalesW5", "SalesW6", "SalesW7", "SalesW8", "SalesW9", "SalesW10", _
   "SalesW11", "SalesW12", "SalesW13", "SalesW14", "SalesW15"))
  

  And

  'Set arrays for source and destination sheets
  A = Array("DP-SalesW1", "DP-SalesW2", "DP-SalesW3", "DP-SalesW4", "DP-SalesW5", "DP-SalesW6", "DP-SalesW7", _
   "DP-SalesW8", "DP-SalesW9", "DP-SalesW10", "DP-SalesW11", "DP-SalesW12", "DP-SalesW13", "DP-SalesW14", "DP-SalesW15")
  B = Array("SalesW1", "SalesW2", "SalesW3", "SalesW4", "SalesW5", "SalesW6", "SalesW7", "SalesW8", "SalesW9", _
   "SalesW10", "SalesW11", "SalesW12", "SalesW13", "SalesW14", "SalesW15")
  

  I would recommend declaring these and then calling them to each sub so that you don't have to rewrite them. An example of how to call a variable to a sub is:

  Sub CopyResults(byref MyArray as variant)
  

  Further reading here, and here, and here. By using those parenthesis at the sub declaration, you can pass variables across procedures and only declare them once. Saves quite a bit of typing.

  Another way to get the most out of your variables is to name them effectively. Instead of A = Array(...) try something like SalesWSArray = Array(...). This wraps the fact that it is an array, it refers to the worksheets (WS), and it refers specifically to the Sales worksheets, all tied up in a nice variable.

• Repeated code can usually be compressed

  I see you have a long piece of code starting here:

  'Add Named Range
  Sheets("SalesW1").Select
  Columns("A:B").Select
  Range("B1").Activate
  ActiveWorkbook.Names.Add Name:="SalesW1", RefersToR1C1:="='SalesW1'!C1:C2"
  Sheets("SalesW2").Select
  Columns("A:B").Select
  Range("B1").Activate
  'etc etc....
  

  You created a great array and loop but then didn't utilize it. If you see a piece of code that is doing the same thing over and over again, it can most likely be shoved into a function or a loop. Such as:

  For i = 1 to UBound(SalesWSArray)
   ActiveWorkbook.Names.Add Name:= SalesWSArray(i), RefersToR1C1:="='" & SalesWSArray(i) & "'!C1:C2"
  Next i
  

  I assumed here that your worksheet array was 1D with a 0 base. By starting at i = 1, this loop will be able to hit the first worksheet in the array (Sheets("SalesW1").Select) and pull the data you need.

• Procedural Organization

  At then end of your subs you have Call NamedSub. I see that in most cases the called sub is the very next one. VBA is linear and will automatically flow down the written page unless you tell it otherwise. There is no need to call the next sub unless it is specifically out of order (such as the function you have at the very bottom of your code). Also you don't need to 'call' a sub. Simply reference it by name if it's in the same module, or by module.subname if it resides in a difference module:

  Sub TestRuns()
   SubSameModule anyVariablesYouAreReferencing
   Module2.SubDifferentModule anyVariablesYouAreReferencing
  End Sub
  

• General Tips and Suggestions

  I recommend hitting up StackOverflow and reading all the questions and answers you can. Sometimes things other people do are things you do, and you can get a good idea of VBA convention and best practice. Also read the reviews on here to get an idea of what developers expect and notice about VBA coding.

Please note none of these examples have been tested and please remember to save all your work before implementing anything.

• Dan Oberlam: Please consider pulling the key content out of links and into your answer itself, as links may rot.
• tanstaafl1988: @Dannnno right, good point. I have edited my list.
• user109261: ActiveWorkbook.Names.Add Name:= SalesWSArray(i), RefersToR1C1:="='" & SalesWSArray(i) & "'!C1:C2" is the only line needed in the loop.

Answer 2

Variable Declaration

Always turn on Option Explicit. You can have it automatically by going to Tools -> Options in the VBE and checking the Require Variable Declaration option. This way if you have any variables not defined, the compiler will let you know.

Your variable outPut isn't declared. When you don't define your variable, VBA will declare it as a Variant, which are objects:

Performance. A variable you declare with the Object type is flexible enough to contain a reference to any object. However, when you invoke a method or property on such a variable, you always incur late binding (at run time). To force early binding (at compile time) and better performance, declare the variable with a specific class name, or cast it to the specific data type.

.

Dim DataSh, ResultsSh As Worksheet

You don't realize it here, but you aren't giving DataSh a type -

Dim Datash as Worksheet, ResultsSh as Worksheet

Same goes for

Dim A, B
Dim srcRng
Dim ValueSh

Once again, it's a variant.

 Dim i As Integer

Integers - integers are obsolete. According to msdn VBA silently converts all integers to long.

Variable Naming

Worksheets have a CodeName property - View Properties window (F4) and the (Name) field (the one at the top) can be used as the worksheet name. This way you can avoid Sheets(""Commission Report Template"") and instead just use ReportTemplate.

Standard VBA naming conventions have camelCase for local variables and PascalCase for other variables and names.

Dim DataSh, ResultsSh As Worksheet
Dim A, B
Dim i As Integer
Dim srcRng, destRng As Range
Dim ValueSh, salesSh As Worksheet
Dim rngHidden As Range
Dim Sh As Worksheet
Dim outPut

Give your variables meaningful names! Also, there's no need for that hungarian naming. I'm not going to get into Hungarian vs hungarian vs hungarian apps, but basically, the naming of your variables should tell me what it is, so don't prefix it with a type e.g.

• rngHidden - hiddenRange

Also, what's a Sh? I'd go with something like this -

Dim sourceData As Worksheet
Dim results As Worksheet
Dim arrayOfSheets As Variant 'A or B
Dim sheetNames As Variant 'A or B
Dim index As Long
Dim sourceRange As Range
Dim destinationRange As Range
Dim valueSheet As Worksheet
Dim hiddenRange As Range
Dim targetSheet As Worksheet
Dim outPut As VbMsgBoxResult

Arrays

When you do something like this -

A = Array("DP-SalesW1", "DP-SalesW2", "DP-SalesW3", "DP-SalesW4", "DP-SalesW5", "DP-SalesW6", "DP-SalesW7", _
 "DP-SalesW8", "DP-SalesW9", "DP-SalesW10", "DP-SalesW11", "DP-SalesW12", "DP-SalesW13", "DP-SalesW14", "DP-SalesW15")

You could probably find a better way, even just as simple as

Const DP_SHEET_NAMES As String = "DP-SalesW1, DP-SalesW2, DP-SalesW3, DP-SalesW4, DP-SalesW5, DP-SalesW6, DP-SalesW7, DP-SalesW8, DP-SalesW9, DP-SalesW10, DP-SalesW11, DP-SalesW12, DP-SalesW13, DP-SalesW14, DP-SalesW15"
Const DELIMITER As String = ","
dpSheetsArray = Split(DP_SHEET_NAMES, DELIMITER)

Or

Dim sheetNames() As String
ReDim sheetNames(1 To 15)
Dim sheetNameIndex As Long
For sheetNameIndex = 1 To 15
 sheetNames(sheetNameIndex) = "DP - SalesW" & sheetNameIndex
Next

Or a combination

Const SHEET_PREFIX As String = "DP - SalesW"
Dim sheetNames() As String
ReDim sheetNames(1 To 15)
Dim sheetNameIndex As Long
For sheetNameIndex = 1 To 15
 sheetNames(sheetNameIndex) = SHEET_PREFIX & sheetNameIndex
Next

You see where I'm going. Constants are useful, as are loops.

Comments

Comments - "code tell you how, comments tell you why". The code should speak for itself, if it needs a comment, it might need to be made more clear. If not, the comment should describe why you're doing something rather than how you're doing it. Here are a few reasons to avoid comments all together.

You have a lot of comments, explaining what is happening. That's an indication that your code isn't clear enough.

'Remove previous template results
 Worksheets(Commission Report Template).Select
 If lastRow > 4 Then
 Range(A5:C & lastRow).Delete Shift:=xlUp
 Range(D4:P & lastRow).Delete Shift:=xlUp
 Range(Q5:S & lastRow).Delete Shift:=xlUp
 Else
 End If

Looks like you could probably use some Named Ranges in the sheet.

Instead of hard-coding names, if they are static, assign them a named range property. e.g. instead of Sheets("mySheet").Range("A1:A10") you can have mysheet.Range("MyNamedRange").

.Select

It's been mentioned, but be sure to avoid things like .Select - it just slows the code down by needing to fiddle with the spreadsheet while doing everything else behind the scenes. There's a good question on StackOverflow addressing this.

Call Sub

Call CopyResults

Can just be

CopyResults

You don't need to Call subs, it's obsolete. Instead just use Sub argument, argument

Arrays

What you're suffering from is beginner's luck. I've been there, everyone has been there. How do we know what is better than doing what you're doing? Because we've done it and been told "hey, there's a better way!". So, don't get discouraged.

But, everything you're doing should be done in an array.

For Example-

'Copy DP-CustomerDates
 Sheets(DP - CustomerDates).Select
 Range(A1:D & lastRow).Select
 Selection.Copy
 'Paste customer dates
 Sheets(CustomerDates).Select
 Range(A1).Select
 Selection.PasteSpecial Paste:=xlPasteValues

Would be much faster as

Dim results As Variant
results = Sheets(DP - CustomerDates).Range(.Cells(1, 1), .Cells(lastRow, 4))
Sheets("CustomerDates").Range(.Cells(1, 1), .Cells(lastRow, 4)) = results

Copy and Pasting is extremely inefficient. Give using arrays a try!

Refactoring

You say

I find there is a lot of redundant code which I think could be streamlined

That's called refactoring. Let's take the loop in SalesTotals() for a spin

For Each salesSh In Sheets(Array(SalesW1, SalesW2, SalesW3, SalesW4, SalesW5, SalesW6, SalesW7, _
 SalesW8, SalesW9, SalesW10, SalesW11, SalesW12, SalesW13, SalesW14, SalesW15))
 salesSh.Select
 'Subtotal
 On Error Resume Next
 'Add column heading
 Range(AX1).Select
 ActiveCell.Formula = Sales
 'Sum each row and fill down
 Range(AX2).Select
 ActiveCell.Formula = =SUM(B2:AB2)-SUM(AC2:AW2)
 Range(AX2:AX & lastRow).FillDown
 'Remove formulas
 Range(AX2:AX & lastRow).Select
 Selection.Copy
 Selection.PasteSpecial Paste:=xlPasteValues
 'Remove details
 Columns(B:AW).Select
 Selection.EntireColumn.Delete
 Range(A1).Select
 Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
 Replace:=True, PageBreaks:=False, SummaryBelowData:=True
 'Remove subtotal formulas
 Range(B2:B & lastRow + 1).Select
 Selection.Copy
 Selection.PasteSpecial Paste:=xlPasteValues
 'View Totals
 ActiveSheet.Outline.ShowLevels RowLevels:=2
 Range(A1).Select
 'Remove Total
 With Range(A:A)
 .Replace What:= Total, Replacement:=, LookAt:=xlPart, _
 SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
 ReplaceFormat:=False
 End With
 Next

First to note is that all of those columns Range and ActiveCell are unqualified. You need to explicitly state where they are (ignoring the .Select issue for now)

For index = LBound(salessheets) To UBound(salessheets)
 Set salessheet = ThisWorkbook.Sheets(salessheets(index))
 With salessheet
 .Range("AX1").Select
 .Selection.Copy
 '...
 End With
Next

Right, now we know where the range is, explicitly. As far as refactoring it, it could become

Dim index As Long
For index = LBound(salessheets) To UBound(salessheets)
 Set salessheet = ThisWorkbook.Sheets(salessheets(index))
 ClearTotals salessheet
Next

with

Private Sub ClearTotals(ByVal targetSheet As Worksheet)
 With targetSheet
 'Subtotal
 On Error Resume Next
 'Add column heading
 Range(AX1).Select
 ActiveCell.Formula = Sales
 'Sum each row and fill down
 Range(AX2).Select
 .ActiveCell.Formula = "=SUM(B2:AB2)-SUM(AC2:AW2)"
 .Range("AX2:AX" & lastRow).FillDown
 'Remove formulas
 .Range("AX2:AX" & lastRow).Select
 Selection.Copy
 Selection.PasteSpecial Paste:=xlPasteValues
 'Remove details
 .Columns("B:AW").Select
 Selection.EntireColumn.Delete
 Range(A1).Select
 Selection.Subtotal GroupBy:=1, Function:=xlSum, TotalList:=Array(2), _
 Replace:=True, PageBreaks:=False, SummaryBelowData:=True
 'Remove subtotal formulas
 .Range("B2:B" & lastRow + 1).Select
 Selection.Copy
 Selection.PasteSpecial Paste:=xlPasteValues
 'View Totals
 ActiveSheet.Outline.ShowLevels RowLevels:=2
 Range("A1").Select
 'Remove Total
 With .Columns("A").Replace(What:="Total", Replacement:="Something", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False)
 End With
 End With
End Sub

That's refactoring, for instance. But you still have the issue of .Select and everything else.

An example of that refactored sub might be

 With targetSheet
 Dim newValues As Variant
 Dim oldValues As Variant
 Dim index As Long
 Dim sumIndex As Long
 Dim firstValue As Long
 Dim secondValue As Long
 oldValues = targetSheet.Range(.Cells(2, 1), .Cells(49, lastRow))
 ReDim newValues(1 To lastRow - 1)
 For index = 1 To UBound(newValues)
 For sumIndex = 1 To 28
 firstValue = firstValue + oldValues(index, sumIndex)
 Next
 For sumIndex = 29 To 49
 secondValue = secondValue + oldValues(index, sumIndex)
 Next
 newValues(index) = firstValue - secondValue
 Next
 targetSheet.Range(.Cells(1, 1), .Cells(1, UBound(newValues))) = newValues
End With

I can't guarantee that's exactly what you're trying to do, but it's a start.

Heck (and I'm spit-balling here), I'd even say you could do something like

 For index = LBound(salessheets) To UBound(salessheets)
 Dim tempArray as Variant
 Set salessheet = ThisWorkbook.Sheets(salessheets(index))
 tempArray = GetSums(salesSheet)
 salseSheet.Range(.Cells(1,1),.Cells(1,Ubound(tempArray)) = tempArray
 Next
Private Function GetSums(ByVal TargetSheet as Worksheet) as Variant
 'Do the stuff
 ' GetSums = newValues
End Function

---

Without Test Data

Here's an example of how I might approach the first two procedures of yours

Sub RefreshData()
 Const DATA_SHEETS As String = "DP-CustomerDates, DP-FirstDeliveries, DP-SalesW1, DP-SalesW2, DP-SalesW3, DP-SalesW4, DP-SalesW5, DP-SalesW6, DP-SalesW7, DP-SalesW8, DP-SalesW9, DP-SalesW10, DP-SalesW11, DP-SalesW12, DP-SalesW13, DP-SalesW14, DP-SalesW15"
 Dim dataSheet As Worksheet
 Dim sheetNames As Variant
 sheetNames = Split(DATA_SHEETS, ",")
 Dim index As Long
 Dim targetListObject As ListObject
 Dim resultSheet As Worksheet
 With Application
 .DisplayAlerts = False
 .EnableEvents = False
 .ScreenUpdating = False
 End With
 For index = LBound(sheetNames) To UBound(sheetNames)
 Set dataSheet = Sheets(sheetNames(index))
 With dataSheet
 Set targetListObject = .ListObjects(1)
 targetListObject.DataBodyRange.Rows.Delete
 targetListObject.QueryTable.Refresh False
 .Rows.Hidden = False
 .Columns("A:AX").Delete shift:=xlToLeft
 End With
 Next
 Dim lastRow As Long
 Set dataSheet = Worksheets("Commission Report Template")
 With dataSheet
 lastRow = .Cells(Rows.Count, 1).End(xlUp).Row
 If lastRow > 4 Then
 .Range("A5:C" & lastRow).Delete shift:=xlUp
 .Range("D4:P" & lastRow).Delete shift:=xlUp
 .Range("Q5:S" & lastRow).Delete shift:=xlUp
 End If
 End With
 CopyResults sheetNames
End Sub
Sub CopyResults(ByVal sourceSheetNames As Variant)
 Const TARGET_SHEET_NAMES As String = "SalesW1, SalesW2, SalesW3, SalesW4, SalesW5, SalesW6, SalesW7, SalesW8, SalesW9,SalesW10, SalesW11, SalesW12, SalesW13, SalesW14, SalesW15"
 Dim targetSheetNames As Variant
 targetSheetNames = Split(TARGET_SHEET_NAMES, ",")
 Dim dataSheet As Worksheet
 Dim targetSheet As Worksheet
 Dim lastRow As Long
 Dim lastColumn As Long
 Dim firstVariant As Variant
 Dim index As Long
 Set dataSheet = Sheets(sourceSheetNames(1))
 firstVariant = GetArray(dataSheet, 4)
 Sheets("CustomerDates").Range(.Cells(1, 1), .Cells(UBound(firstarray), 4)) = firstVariant
 Set dataSheet = Sheets(sourceSheetNames(2))
 firstVariant = GetArray(dataSheet, 3)
 Sheets(FirstDeliveries).Range(.Cells(1, 1), .Cells(UBound(firstarray), 3)) = firstVariant
 For index = 3 To UBound(sourceSheetNames)
 Set dataSheet = Sheets(sourceSheetNames(index))
 Set targetSheet = Sheets(targetSheetNames(index - 2))
 lastRow = dataSheet.Cells(Rows.Count, 1).End(xlUp).Row
 lastColumn = dataSheet.Cells(1, Columns.Count).End(xlToLeft).Column
 targetSheet.Range(.Cells(1, 1), .Cells(lastRow, lastColumn)) = dataSheet.Range(.Cells(1, 1), .Cells(lastRow, lastColumn))
 Next
 CustomerDates
End Sub