Appendix Thread. ( Codes for other Threads, etc.) Event Coding Drpdown Data validation

**DocAElstein** · 05-19-2020, 03:08 PM

Macro for this post:
https://excelfox.com/forum/showthrea...ll=1#post13397

Code:


Sub ConditionalCalcPaste()   '    https://excelfox.com/forum/showthread.php/2495-Conditional-calculation-and-pasting-of-the-data
Rem 1 Worksheets info
'1a)  2.xlsx
Dim Wb2 As Workbook
 Set Wb2 = Workbooks("2.xlsx")
Dim Ws1 As Worksheet: Set Ws1 = Wb2.Worksheets.Item(1)
Dim Lr1 As Long
 Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row
Dim arrA() As Variant: Let arrA() = Ws1.Range("A1:A" & Lr1 & "").Value2          '  2.xlsx sheet1 column A
'Dim Ws2 As Worksheet: Set Ws2 = Wb2.Worksheets.Item(2)
'Dim Rng22 As Range: Set Rng22 = Ws2.Range("A1").CurrentRegion                    ' Row to be copied - (only first row)entire row of data from sheet2 of 2.xlsx

'1b) Actual File.xlsx
Dim Wb As Workbook, Ws As Worksheet
 Set Wb = Workbooks("Actual File.xlsx")
 Set Ws = Wb.Worksheets.Item(1)
Dim Lr As Long: Let Lr = Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row                                                 ' Dim Jmax As Long: Let Jmax = Ws.Range("J" & Ws.Rows.Count & "").End(xlUp).Row

Dim rngIn As Range: Set rngIn = Ws.Range("A1:S" & Lr & "")
Dim arrIn() As Variant, arrOut() As Variant: Let arrIn() = rngIn.Value2
Dim arrB() As Variant: Let arrB() = Ws.Range("B1:B" & Lr & "").Value2            '  Ws.Range("B1:B" & Jmax & "").Value2          ' Actual File.xlsx sheet1 column B

'1c '  calculate the total value of column Q of ActualFile.xlsx and if it is Greater than S10 of ActualFile.xlsx then
Dim SomeQ As Double: Let SomeQ = Ws.Evaluate("=SUM(Q2:Q" & Lr & ")") '   total value of column Q of ActualFile.xlsx
 Let SomeQ = Application.WorksheetFunction.Round(SomeQ, 2)
Dim S10Val As Double: Let S10Val = arrIn(10, 19)                     '   S10 of ActualFile.xlsx
    If SomeQ > S10Val Then      '  total value of column Q of ActualFile.xlsx and if it is Greater than S10 of ActualFile.xlsx then do nothing
    ' do nothing
    ElseIf SomeQ < S10Val Then  ' if it is lower than S10 of ActualFile.xlsx then divide S10 of ActualFile.xlsx with the total value of Column Q of ActualFile.xlsx
    Dim S10dQ As Double: Let S10dQ = S10Val / SomeQ ' Divide S10 of ActualFile.xlsx with the total value of Column Q of ActualFile.xlsx
      Let S10dQ = Int(S10dQ) ' Application.WorksheetFunction.Round(S10dQ, 4)
    Dim Cnt '                                               this is for - going down column A of 2.xlsx sheet1 looking for a match in  Actual File.xlsx sheet1 column B
        For Cnt = 2 To Lr1 '                               Jmax
        Dim MtchRes As Variant
         Let MtchRes = Application.Match(arrA(Cnt, 1), arrB(), 0)  '    - going down column A of 2.xlsx sheet1 looking for a match in  Actual File.xlsx sheet1 column B
            If IsError(MtchRes) Then
            ' no match  do nothing
            Else ' Cnt is now at the row number of where  2.xlsx sheet1 column A  was found in  Actual File.xlsx sheet1 column B
            Dim Lc1Cnt As Long: Let Lc1Cnt = Ws1.Cells.Item(Cnt, Ws1.Columns.Count).End(xlToLeft).Column
            ' Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").ClearContents ' clear row Cnt of all data before pasting
            ' Rng22.Copy Destination:=Ws1.Range("B" & Cnt & "")                ' copy the (only first row)entire row of data from sheet2 of 2.xlsx and paste it to the row in  sheet 1 of 2.xlsx  at the row number of the matched value of 2.xlsx sheet1
             Let Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").Value = Ws1.Evaluate("=" & S10dQ & "*" & Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").Address & "")  ' Ws1.Evaluate("=2*" & Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").Address & "") '   then double the value of that row of 2.xlsx
            End If
        Next Cnt
    Else
    ' Sum = S10
    End If ' SumQ>S10
End Sub