Appendix-Thread-Evaluate-Range-(-Codes-for-other-Threads-HTML-Tables-etc-)

**DocAElstein** · 03-30-2020, 12:35 AM

In support of this Post:
http://www.excelfox.com/forum/showth...ll=1#post13014

Before:

_____ Workbook: sample1.xlsx ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E	F	G	H
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ACC	EQ	1000	1030	955.5	998.45	957.4
3	NSE	ADANIENT	EQ	27.35	27.75	25.65	25.65	25.85
4	NSE	ADANIPORTS	EQ	259	259.6	244	248.2	251.3
5	NSE	ADANIPOWER	EQ	5, 4	5, 5	5, 6	5, 7	5, 8
6	NSE	AMARAJABAT	EQ	459.8	482.25	445.1	439.35	455.35
7	NSE	AMBUJACEM	EQ	7, 4	7, 5	7, 6	7, 7	7, 8
8	NSE	APOLLOHOSP	EQ	8, 4	8, 5	8, 6	8, 7	8, 8
9

Worksheet: anything

_____ Workbook: sample2.xlsx ( Using Excel 2007 32 bit )

_Row\^Col	A
1	SYMBOL
2	ACC
3	ADANIPORTS
4	AMARAJABAT
5

Worksheet: anything

run macro:

Code:

'  http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste/page2#post13014  http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste?p=13014&viewfull=1#post13014
'  http://www.excelfox.com/forum/showthread.php/2445-copy-and-paste-by-vba           http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste?p=13014&viewfull=1#post13014
Sub STEP6d() ' match column B of sample1.xlsx matches with column A of sample2.xlsx
'              if it matches then copy paste the data from column D to column H to sample2.xlsx from column B
Dim Wb1 As Workbook, Wb2 As Workbook                    '           If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
 Set Wb1 = Workbooks("sample1.xlsx")   '                       Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")                ' w1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")           ' change the file path   If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
 Set Wb2 = Workbooks("sample2.xlsx")   '                       Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\FundsCheck.xlsb")      ' w2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\FundsCheck.xlsb") ' change the file path      If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
Dim Ws1 As Worksheet, Ws2 As Worksheet
 Set Ws1 = Wb1.Worksheets("anything")  '     sheet name can be anything
 'Set Ws1 = Wb1.Worksheets.Item(1)
 Set Ws2 = Wb2.Worksheets("anything")
 'Set Ws2 = Wb2.Worksheets.Item(1)
Dim Lr1 As Long, Lr2 As Long  '   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. )
 Let Lr1 = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
 Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count).End(xlUp).Row

Dim Cnt As Long
    For Cnt = 2 To Lr2
    Dim FndCel As Range  '  http://www.excelfox.com/forum/showthread.php/2436-conditionally-delete-or-replace-entire-row?p=13007&viewfull=1#post13007
    Dim rngSrch As Range '
     Set rngSrch = Ws1.Range("B2:B" & Lr1 & "")
     Set FndCel = rngSrch.Find(What:=Ws2.Range("A" & Cnt & "").Value, After:=Ws1.Range("B2"), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) '   https://stackoverflow.com/questions/49094391/excel-vba-range-findnext-v-range-find-what-have-i-missed/49181464#49181464
    ' The range to be copied is always offset by 0 rows  and +2 column from the cell found, FndCel,  in column B of sample1.xlsx . Its size will be 1 row and 5 columns
     FndCel.Offset(0, 2).Resize(1, 5).Copy '     copy column D to column H
    ' paste the data from column D to column H to sample2.xlsx from column B
     Ws2.Range("A" & Cnt & "").Offset(0, 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    Next Cnt
End Sub