New macro ( for http://www.excelfox.com/forum/showth...3144#post13144 )
Code:Sub STEP8_AE() ' http://www.excelfox.com/forum/showthread.php/2461-copy-and-paste-by-vba?p=13126&viewfull=1#post13126 Rem 1 Worksheets data range info Dim Wb1 As Workbook, Wb2 As Workbook Dim Ws1 As Worksheet, Ws2 As Worksheet Set Wb1 = Workbooks("1.xls") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls") Set Wb2 = Workbooks("AlertTestData.xlsx") ' Workbooks("Alert.csv") ' Workbooks("Alert.txt") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert..csv") Set Ws1 = Wb1.Worksheets.Item(1) Set Ws2 = Wb2.Worksheets.Item(1) Dim Rg1 As Range, RngSrchIn As Range Set Rg1 = Ws1.Cells.Item(1, 1).CurrentRegion Dim Lr2 As Long: Let Lr2 = Ws2.Range("B" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. ) Set RngSrchIn = Ws2.Range("B1:B" & Lr2 & "") ' Only us as much of Column B as we need to search in for a match Rem 2 Dim Cnt For Cnt = 2 To Rg1.Rows.Count ' For all rows in 1.xls Dim cRng As Range '2a Check for match, BUT DO IT PROPERLY!!! - http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13142&viewfull=1#post13142 Set cRng = RngSrchIn.Find(What:=Ws1.Cells.Item(Cnt, 9), LookIn:=xlValues, Lookat:=xlWhole, searchorder:=xlByRows, Searchdirection:=xlNext, MatchCase:=True) If Not cRng Is Nothing And Not cRng.Value = "" Then If Ws1.Cells(Cnt, 8) > Ws1.Cells(Cnt, 4) Then ' if column H of 1.xls is greater than column D of 1.xls Let cRng.Offset(, 2).Value = "<" ' put this symbol "<" in column D of 2 Let cRng.Offset(, 3).Value = Ws1.Cells(Cnt, 11) ' copy paste the data of column K of 1.xls in column E of 2.csv ElseIf Ws1.Cells(Cnt, 8) < Ws1.Cells(Cnt, 4) Then ' if column H of 1.xls is lower than column D of 1.xls Let cRng.Offset(, 2).Value = ">" ' then put this symbol ">" in column D of 2.csv Let cRng.Offset(, 3).Value = Ws1.Cells(Cnt, 11) ' copy paste the data of column K of 1.xls in column E of 2.csv Else ' column H of 1.xls is equal to column D of 1.xls End If Else ' cRng is nothing so no match was found, or cell was empty ' do nothing End If Next Cnt End Sub ' If .Cells(i, 8) > .Cells(i, 4) Then ' if column H of 1.xls is greater than column D of 1.xls ' If .Cells(i, 9).Value = "" Then ' ' do nothing ' Else ' Set c = Ws2.Columns(2).Find(.Cells(i, 9)) ' match column I of 1.xls with column B of 2.csv ' If Not c Is Nothing Then 'if match found ' c.Offset(, 2).Value = "<" ' put this symbol "<" in column D of 2 ' c.Offset(, 3).Value = .Cells(i, 11) ' copy paste the data of column K of 1.xls in column E of 2.csv ' End If ' End If ' Else ' if column H of 1.xls is lower than column D of 1.xls ' If .Cells(i, 9).Value = "" Then ' ' do nothing ' Else ' Set c = Ws2.Columns(2).Find(.Cells(i, 9)) ' match column I of 1.xls with column B of 2.csv ' If Not c Is Nothing Then 'if match found ' c.Offset(, 2).Value = ">" ' then put this symbol ">" in column D of 2.csv ' c.Offset(, 3).Value = .Cells(i, 11) ' copy paste the data of column K of 1.xls in column E of 2.csv ' End If ' End If ' End If




Reply With Quote
Bookmarks