Public Function Format_PayBill_Audit_Pivot_Report()
'Created by Joel Hardesty Apr 2013
'Creates 2 WB's with pivot tables
Dim intLastColPrev As Integer
Dim intLastColSht1 As Integer
Dim strWB_Report As String
Dim strWB_Ref As String
Dim lngLastRowPrev As Long
Dim lngSheet1_LastRow As Long
Dim rngTemp As Range
Dim rngSht1MatchCol As Range
Dim rngPreviousShtRange As Range
Dim rngPrevShtMatchCol As Range
Dim strSearchCell As String
Dim strSearchColumn As String
Dim intDestinationColOffsetfromSearchColumn As Integer
Dim strSht1Name As String
Dim strSht2Name As String
Dim strMatchcell As String
Dim strReference As String
Dim strLookup_Array As String
Dim strFormula As String
Dim intSht1CritriaColPos As Integer
Dim intSht2CritriaColPos As Integer
Dim inteARFlagPos As Integer
Dim strMatchCol As String
strWB_Report = ActiveWorkbook.name
'open user form 1, let user select Account, capture Buyer Code and Password
'open WB, load cboRpt from sheet
Workbooks.Open ("\\hqntapp02\pbar\RESEARCH TEAM\Pay Bill Audit Pivot table reports\PayBill_Audit_Pivot_Ref.xlsx")
strWB_Ref = ActiveWorkbook.name
Load UserForm1
With UserForm1
.Caption = "Select Account"
With .cboRpt
.ColumnCount = 3
.ColumnWidths = "1,0,0"
.List = Workbooks(strWB_Ref).Sheets("CWO PASSWORDS").Range("A1").CurrentRegion.Value
End With
End With
UserForm1.Show
'User must copy previous weeks report into current WB
'and rename to "Previous"
'Unhide all columns,Remove filters, colors from both sheets
'select Previous sheet
Workbooks(strWB_Report).Sheets(2).Activate
Call CleanSheet
'get last col for Previous sheet
intLastColPrev = ActiveSheet.Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).column
lngLastRowPrev = ActiveSheet.Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).row
intSht2CritriaColPos = WorksheetFunction.Match("CRITERIA", Sheets(2).Rows(3), 0)
inteARFlagPos = WorksheetFunction.Match("eAR Flag", Sheets(2).Rows(3), 0)
'select first sheet
Workbooks(strWB_Report).Sheets(1).Activate
Call CleanSheet
'get last col for Sheet(1)
intLastColSht1 = ActiveSheet.Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByColumns).column
lngSheet1_LastRow = ActiveSheet.Cells.Find(What:="*", _
SearchDirection:=xlPrevious, _
SearchOrder:=xlByRows).row
intSht1CritriaColPos = WorksheetFunction.Match("CRITERIA", Sheets(1).Rows(3), 0)
'set variables for Sheet1
strSht1Name = Sheets(1).name
'get col # for Criteria Column
Set rngTemp = Sheets(1).Rows(3).Find("Criteria")
If Not rngTemp Is Nothing Then
intSht1CritriaColPos = rngTemp.column
Set rngTemp = Nothing
Else
MsgBox "Column Criteria Not Found on Sheet: " & strSht1Name _
& vbCrLf & vbCrLf & "Please verify the column name Criteria is in the first worksheet.", _
vbOKOnly, "Missing Column 'Criteria' in Worksheet " & strSht1Name & "!"
Exit Function
End If
With Sheets(strSht1Name)
'row,col 'row,col
strMatchcell = .Range(.Cells(4, intSht1CritriaColPos), .Cells(4, intSht1CritriaColPos)).Address
End With
'remove $
strMatchcell = Replace(strMatchcell, "$", "", 1, , vbTextCompare)
strMatchcell = strSht1Name & "!" & strMatchcell
'set variables for Sheet2 "Previous"
strSht2Name = Sheets(2).name
'get col # for Criteria Column
Set rngTemp = Sheets(2).Rows(3).Find("Criteria")
If Not rngTemp Is Nothing Then
intSht1CritriaColPos = rngTemp.column
Set rngTemp = Nothing
Else
MsgBox "Column Criteria Not Found on Sheet: " & strSht2Name _
& vbCrLf & vbCrLf & "Please verify the column name Criteria is in the first worksheet.", _
vbOKOnly, "Missing Column 'Criteria' in Worksheet " & strSht2Name & "!"
Exit Function
End If
With Sheets(strSht2Name)
'row,col 'row,col
strReference = .Range(.Cells(4, intLastColPrev), .Cells(lngLastRowPrev, intLastColPrev)).Address
strMatchCol = .Range(.Cells(4, intSht1CritriaColPos), .Cells(lngLastRowPrev, intSht1CritriaColPos)).Address
End With
strReference = strSht2Name & "!" & strReference
strMatchCol = strSht2Name & "!" & strMatchCol
'use INDEX and MATCH to add previous comments to last col in sheet 1
' ***** Note - no need to name cell for return value, it is the cell the formula sits in
' ***** Header row in row 3
'working formula
'=INDEX(PREVIOUS!$AN$4:$AN$115,MATCH(GE!D4,PREVIOUS!$E$4:$E$115,0),1) 'use this one
'=VLOOKUP(D4,PREVIOUS!$E$4:$AN$115,37,FALSE)
'generic formula
'=INDEX(reference, MATCH(lookup_cell, lookup_array, match_type), column_num)
'
'****** Build this string dynamically
' 'Data Range Return value 'Column to find Match
' =INDEX(PREVIOUS!$AN$4:$AN$115,MATCH(GE!E4,PREVIOUS!$E$4:$E$115,0),1) 'use this one
' '$ will not increment 'match cell 'offset from Index for return value
' 'with AutoFill 'will be incremented '1 returns same column value
'
'
'**********************
strFormula = "=INDEX(" & strReference & ",MATCH(" & strMatchcell & "," & strMatchCol & ",0),1)"
Sheets(1).Cells(4, (intLastColSht1 + 1)).Formula = strFormula
' Range("AK4").AutoFill Range("AK4:AK" & lngLastRowPrev - 1)
With Sheets(1)
Range(.Cells(4, (intLastColSht1 + 1))).AutoFill Range(.Cells(4, (intLastColSht1 + 1), .Cells(lngSheet1_LastRow, (intLastColSht1 + 1))))
End With