Macro for last post, and to answer this post:
https://excelfox.com/forum/showthrea...ll=1#post13401
Code:
Sub CopyPaste20Q2b() ' https://excelfox.com/forum/showthread.php/2494-Copy-and-paste-of-data-if-matches?p=13401&viewfull=1#post13401
Rem 1 Worksheets info
' 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
' Actual File.xlsx
Dim Wb As Workbook, Ws As Worksheet
Set Wb = Workbooks("Actual File.xlsx")
Set Ws = Wb.Worksheets.Item(1)
Dim Jmax As Long: Let Jmax = Ws.Range("J" & Ws.Rows.Count & "").End(xlUp).Row
Dim arrB() As Variant: Let arrB() = 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 Lr As Long: Let Lr = Ws.Range("A" & Ws.Rows.Count & "").End(xlUp).Row
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 = Ws.Range("S10").Value ' 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 this macro should do the process
Rem 2 do it
Dim Cnt ' this is for - going down column A of 2.xlsx sheet1 looking for a match in Actual File.xlsx sheet1 column B but only as far as JMax
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("=2*" & Ws1.Range("B" & Cnt & ":" & CL(Lc1Cnt) & Cnt & "").Address & "") ' then double the value of that row of 2.xlsx
End If
Next Cnt
Else
' else do nothing
End If
End Sub
Bookmarks