LloydFinancials
Well-known Member
- Joined
- Apr 24, 2015
- Messages
- 546
VBA Code:
Sub Macro2()
Dim lrPRV As Long
Dim lcPRV As Long
Dim lrPGLV As Long
Dim lcPGLV As Long
Dim S1 As String
Dim S2 As String
Dim S3 As String
Dim S4 As String
Dim S5 As String
Dim S6 As String
Dim S7 As String
Dim S8 As String
Dim S9 As String
Dim S10 As String
Dim S11 As String
Dim S12 As String
Dim S13 As String
Dim S23 As String
Dim S24 As String
Dim S25 As String
Dim R1 As Range
Dim R2PRV As Range
Dim R2PGLV As Range
Dim R3 As Range
Dim R4 As Range
Dim R5 As Range
Dim R6 As Range
Dim R7 As Range
Dim R8 As Range
Dim R9 As Range
Dim R10 As Range
Dim R11 As Range
Dim R12 As Range
Dim R13 As Range
Dim R23PGLV As Range
Dim R24RDC As Range
Dim R24PRV As Range
Dim R24PGLV As Range
Dim R25 As Range
S1 = "Max Sum of dollars_sent in Customer"
S2 = "Customer"
S3 = "(dollars_sent / Max) > 0.33"
S4 = "Only 1 qualified dollars_sent in Customer [1]"
S5 = "CustomerMax"
S6 = "GL Open Amount for Month"
S7 = "Payment within 75% of Open for Given Month"
S8 = "Only 1 qualified Payment in Customer [2]"
S9 = "[1] and [2] are True"
S10 = "Document Number Rule 1"
S11 = "Assignment"
S12 = "coverage_month"
S13 = "Sum of dollars_sent"
S23 = "YYYYMM"
S24 = "CustomerYYYYMM"
S25 = "Pstng Date"
''Refresh Pivot GL and paste into 'Pivot GL Val'
' Sheets("Pivot GL").Select
' Range("A2").Select
' ActiveSheet.PivotTables("PivotTable35").PivotCache.Refresh
' lrPGL = Sheets("Pivot GL").Cells(Rows.Count, 1).End(xlUp).Row
' lcPGL = Sheets("Pivot GL").Cells(1, Columns.Count).End(xlToLeft).Column
' If lcPGL <> 7 Then
' MsgBox "There should be exactly 7 fields populated in the 'Pivot GL.' The fields are as follows:" & vbCrLf & _
' "Customer" & vbCrLf & "DocumentNo" & vbCrLf & "Doc. Date" & vbCrLf & "Pstng Date" & vbCrLf & "Bline Date" & _
' "Assignment" & vbCrLf & "Amount in Local Crcy" & vbCrLf & "If there are not, then update the 'GL_REPORT' fields to match" & _
' " and rerun the macro."
' Exit Sub
' End If
' ActiveSheet.UsedRange.Select
' Selection.Copy
' Sheets("Pivot GL Val").Select
' Cells(2, 1).Select
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
' Application.CutCopyMode = False
lrPGLV = Sheets("Pivot GL Val").Cells(Rows.Count, 1).End(xlUp).Row
'Find fields and add formulas to tab 'Pivot GL Val.'
With Sheets("Pivot GL Val").Rows(2)
Set R25 = .Find(What:=S25, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R2PGLV = .Find(What:=S2, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R23PGLV = .Find(What:=S23, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R24PGLV = .Find(What:=S24, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
' Cells(3, R23PGLV.Column).Select
' ActiveCell.Formula = "=YEAR(" & Cells(3, R25.Column).Address(rowabsolute:=False, columnabsolute:=False) & ")&TEXT(MONTH(" & _
' Cells(3, R25.Column).Address(rowabsolute:=False, columnabsolute:=False) & "),""00"")"
' Cells(3, R24PGLV.Column).Select
' ActiveCell.Formula = "=" & Cells(3, R2PGLV.Column).Address(rowabsolute:=False, columnabsolute:=False) & "&" & _
' Cells(3, R23PGLV.Column).Address(rowabsolute:=False, columnabsolute:=False)
' Range(Cells(3, R23PGLV.Column).Address(rowabsolute:=False, columnabsolute:=False) & ":" & _
' Cells(3, R24PGLV.Column).Address(rowabsolute:=False, columnabsolute:=False)).Select
' Selection.AutoFill Destination:=Range(Cells(3, R23PGLV.Column).Address & ":" & Cells(lrPGLV, R24PGLV.Column).Address)
' Range(Cells(3, R23PGLV.Column).Address(rowabsolute:=False, columnabsolute:=False) & ":" & _
' Cells(lrPGLV, R24PGLV.Column).Address(rowabsolute:=False, columnabsolute:=False)).Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.Copy
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
' Application.CutCopyMode = False
'Get row number and column number on the outskirts of the tables.
lrPRV = Sheets("Pivot RDC Val +").Cells(Rows.Count, 1).End(xlUp).Row
lcPRV = Sheets("Pivot RDC Val +").Cells(1, Columns.Count).End(xlToLeft).Column
'Find fields in 'Pivot RDC Val +'
With Sheets("Pivot RDC Val +").Rows(3)
Set R1 = .Find(What:=S1, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R2PRV = .Find(What:=S2, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R3 = .Find(What:=S3, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R4 = .Find(What:=S4, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R5 = .Find(What:=S5, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R6 = .Find(What:=S6, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R7 = .Find(What:=S7, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R8 = .Find(What:=S8, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R9 = .Find(What:=S9, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R10 = .Find(What:=S10, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R11 = .Find(What:=S11, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R12 = .Find(What:=S12, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R13 = .Find(What:=S13, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R23PRV = .Find(What:=S23, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R24PRV = .Find(What:=S24, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
'Add formulas to fields in 'Raw Data Copy'
'YYYYMM
Cells(4, R23PRV.Column).Select
ActiveCell.Formula = "=YEAR(" & Cells(4, R12.Column).Address(rowabsolute:=False, columnabsolute:=False) & ")&TEXT(MONTH(" & _
Cells(4, R12.Column).Address(rowabsolute:=False, columnabsolute:=False) & "),""00"")"
'CustomerYYYYMM
Cells(4, R24PRV.Column).Select
ActiveCell.Formula = "=" & Cells(4, R2PRV.Column).Address(rowabsolute:=False, columnabsolute:=False) & "&" & _
Cells(4, R23PRV.Column).Address(rowabsolute:=False, columnabsolute:=False)
'Max Sum of dollars_sent in Customer
Cells(4, R1.Column).Select
'HERE*****************************
ActiveCell.FormulaArray = "=ROUND(MAX(IF($E$4:$E$290=E4,$C$4:$C$290)),2)"
Stop
' ActiveCell.FormulaArray = "=ROUND(MAX(IF(" & Range(Cells(4, R2PRV.Column).Address(rowabsolute:=True, columnabsolute:=True) & ":" & _
' Cells(lrPRV, R2PRV.Column).Address(rowabsolute:=True, columnabsolute:=True)) & "=" & _
' Cells(4, R13.Column).Address(rowabsolute:=False, columnabsolute:=False) & "," & _
' Range(Cells(4, R2PRV.Column).Address(rowabsolute:=True, columnabsolute:=True) & ":" & _
' Cells(lrPRV, R2PRV.Column).Address(rowabsolute:=True, columnabsolute:=True)) & "),2)"
' 'Copy down formulas
' Range(Cells(4, R1RDC.Column).Address(rowabsolute:=False, columnabsolute:=False) & ":" & _
' Cells(4, R24RDC.Column).Address(rowabsolute:=False, columnabsolute:=False)).Select
' Selection.AutoFill Destination:=Range(Cells(4, R1RDC.Column).Address & ":" & Cells(lrRDC, R24RDC.Column).Address)
' Range(Cells(4, R1RDC.Column).Address(rowabsolute:=False, columnabsolute:=False) & ":" & _
' Cells(lrRDC, R24RDC.Column).Address(rowabsolute:=False, columnabsolute:=False)).Select
' Range(Selection, Selection.End(xlDown)).Select
' Selection.Copy
' Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
' :=False, Transpose:=False
' Application.CutCopyMode = False
'Find fields in 'Pivot GL Val'
With Sheets("Pivot GL Val").Rows(1)
Set R18 = .Find(What:=S18, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R19 = .Find(What:=S19, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R20 = .Find(What:=S20, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R23PGLV = .Find(What:=S23, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R24PGLV = .Find(What:=S24, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R25 = .Find(What:=S25, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
Set R26 = .Find(What:=S26, _
LookAt:=xlWhole, _
LookIn:=xlFormulas, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
End With
End Sub
Result =ROUND(MAX(IF($E$4:$E$290=E4,$C$4:$C$290)),2) instead of {=ROUND(MAX(IF($E$4:$E$290=E4,$C$4:$C$290)),2)}