Appendix Thread. App Index Rws() Clms() Majic code line Codings for other Threads, Tables etc.)

( This post is https://excelfox.com/forum/showthrea...ll=1#post13695 )

---

Some notes related to these posts

https://excelfox.com/forum/showthrea...rt-Csv-To-Xlsx https://excelfox.com/forum/showthrea...ll=1#post13318
http://www.eileenslounge.com/viewtopic.php?f=30&t=34610
http://www.eileenslounge.com/viewtop...267706#p267706
http://www.eileenslounge.com/viewtop...269104#p269104
http://www.eileenslounge.com/viewtopic.php?f=30&t=34638
https://chandoo.org/forum/threads/fe...2/#post-264364

---

---

Field1

Field2

Field3

Field4

Field5

Field6

Field7

Field8

Field9

Field10

Field11

Data Files

F1

F2

F3

F4

F5

F6

F7

F8

F9

F10

F11

Row1

Line1

Record1

USA

101010

6

<

12783

A

GTT

Row2

Line2

Record2

USA

22

6

<

12783

A

GTT

Row3

Line3

Record3

USA

17388

6

<

12783

A

GTT

Row4

Line4

Record4

USA

100

6

<

12783

A

GTT

Row5

Line5

Record5

USA

25

6

<

12783

A

GTT

Data files are held in computer memory in different forms and retrieved in different ways. Any particular value may be referrenced in many different ways.

Some notes related to these posts
https://excelfox.com/forum/showthrea...ll=1#post13318
http://www.eileenslounge.com/viewtopic.php?f=30&t=34610
http://www.eileenslounge.com/viewtop...267706#p267706


Later

Some notes related to these posts
https://excelfox.com/forum/showthrea...ll=1#post13318
http://www.eileenslounge.com/viewtopic.php?f=30&t=34610
http://www.eileenslounge.com/viewtop...267706#p267706


Later

Some notes related to these posts
https://excelfox.com/forum/showthrea...ll=1#post13318
http://www.eileenslounge.com/viewtopic.php?f=30&t=34610
http://www.eileenslounge.com/viewtop...267706#p267706


Later

In support of this post:
https://excelfox.com/forum/showthrea...pplied-over-it

_____ Workbook: address sheet.xlsm ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G
1	Address	Door#	Direction	street name	roadtype	street name + roadtype	City Name
2	204 6 AVE NW	204	6	AVE	NW
3	2510 5 AVE N	2510	5	AVE	N
4	1 CICADA RD	1		CICADA	RD
5	100 annacis Pkwy	100		annacis	Pkwy
6	100 MAIN ST	100		MAIN	ST
7	10008 107 ST	10008		107	ST
8	1001 110 AVE	1001		110	AVE
9	10010 102A AVE NW	10010		102A AVE	NW
10	10115 110 AVE	10115		110	AVE
11	102 11 AVE S	102	S	11	AVE
12	10205 134 AVE NW	10205		134 AVE	NW
13	10235 101 ST NW	10235		101 ST	NW
14	10365 97 ST NW	10365		97 ST	NW
15	105 MARTIN ST	105		MARTIN	ST
16	10504 100 AVE	10504		100	AVE
17	10600 100 ST	10600		100	ST

Worksheet: Sheet1

Some notes in support in answering this question: https://excelfox.com/forum/showthrea...ata-if-matches

If column J has data in actual file.xlsx then match column B of actual file.xlsx with column A of sheet 1 of 2.xlsx and if it matches then copy the (only first row)entire row of data from sheet2 of 2.xlsx and paste it to sheet 1 of 2.xlsx in the row of the matched value in column A of sheet 1 of 2.xlsx
i have pasted the result in sheet3 of 2.xlsx but the result should be in sheet1(I have pasted the result in sheet3 only for understanding purpose)


Before:

If column J has data in actual file.xlsx then match column B of actual file.xlsx
_____ Workbook: Actual File.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ASHOKLEY	EQ	65	65.35	60.55	63.3	63.3		1
3	NSE	BANKBARODA	EQ	62.1	62.95	56.15	56.65	56.65		1
4	NSE	BEL	EQ	66.15	66.75	62.4	65.65	65.65		1
5	NSE	EQUITAS	EQ	82	82.05	71	73.05	73.05		1
6	NSE	FEDERALBNK	EQ	68	68.45	62.45	63.1	63.1		1
7	NSE	GAIL	EQ	85	88.8	79.1	79.95	79.95		1
8	NSE	IDFCFIRSTB	EQ	32.1	32.35	27.2	27.55	27.55

Worksheet: Sheet1

_.................If column J has data in actual file.xlsx then match column B of actual file.xlsx with column A of sheet 1 of 2.xlsx
_____ Workbook: 2 18May.xlsx ( Using Excel 2007 32 bit )

Row\Col	A
1	Stock Name
2	ACC
3	ADANIENT
4	ADANIPORTS
5	ASHOKLEY
6	EQUITAS
7	L&TFH
8

Worksheet: Sheet1

If column J has data in actual file.xlsx then match column B of actual file.xlsx with column A of sheet 1 of 2.xlsx and if it matches then copy the (only first row)entire row of data from sheet2 of 2.xlsx and paste it to sheet 1 of 2.xlsx
_____ Workbook: 2 18May.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L
1	1	2	3	4	5	6	7	8	9	10

Worksheet: Sheet2

_.......copy the (only first row)entire row of data from sheet2 of 2.xlsx and paste it to sheet 1 of 2.xlsx
i have pasted the result in sheet3 of 2.xlsx but the result should be in sheet1(I have pasted the result in sheet3 only for understanding purpose)

After:

_____ Workbook: 2 18May.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M
1	Stock Name	data	data	data	data	data	data	data	data	data	data	data	data
2	ACC	100	108	120	128	134	151	6534	30	90	97	103
3	ADANIENT	101	109	121	127	135	122	782	40	92	98
4	ADANIPORTS	102	110	122	16	137	177	10	50	93	99	104
5	ASHOKLEY	1	2	3	4	5	6	7	8	9	10
6	EQUITAS	1	2	3	4	5	6	7	8	9	10
7	AMBUJACEM	105	117	125	133	140	746	23	80	96	102	109
8

Worksheet: Sheet3

macro for solution to this Thread:
https://excelfox.com/forum/showthrea...ata-if-matches

( Remember to include Public Function CL() )

Code:

---

Sub CopyPaste20()  '  https://excelfox.com/forum/showthread.php/2494-Copy-and-paste-of-data-if-matches
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

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
    For Cnt = 2 To 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
        End If
    Next Cnt
End Sub

'    http://www.excelfox.com/forum/showthread.php/1546-TESTING-Column-Letter-test-Sort
Public Function CL(ByVal lclm As Long) As String '        http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
    Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function

---

Notes for question 2 here
https://excelfox.com/forum/showthrea...ll=1#post13379
https://excelfox.com/forum/showthrea...ll=1#post13387


Before is as here ,
https://excelfox.com/forum/showthrea...ll=1#post13382
, but ignore Sheet2 - no row is to be copied

If column J has data in actual file.xlsx then match column B of actual file.xlsx

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

Row\Col	A	B	C	D	E	F	G	H	I	J	K
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ASHOKLEY	EQ	65	65.35	60.55	63.3	63.3		1
3	NSE	BANKBARODA	EQ	62.1	62.95	56.15	56.65	56.65		1
4	NSE	BEL	EQ	66.15	66.75	62.4	65.65	65.65		1
5	NSE	EQUITAS	EQ	82	82.05	71	73.05	73.05		1
6	NSE	FEDERALBNK	EQ	68	68.45	62.45	63.1	63.1		1
7	NSE	GAIL	EQ	85	88.8	79.1	79.95	79.95		1
8	NSE	IDFCFIRSTB	EQ	32.1	32.35	27.2	27.55	27.55
9	NSE	IOC	EQ	93	93.65	87.25	87.9	87.9
10	NSE	L&TFH	EQ	90	91.55	80.5	81.65	81.65
11

Worksheet: Sheet1 (2)

_.................If column J has data in actual file.xlsx then match column B of actual file.xlsx with column A of sheet 1 of 2.xlsx

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

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Stock Name	data	data	data	data	data	data	data	data	data	data	data	data	data	data
2	ACC	100	108	120	128	134	151	6534	30	90	97	103
3	ADANIENT	101	109	121	127	135	122	782	40	92	98
4	ADANIPORTS	102	110	122	16	137	177	10	50	93	99	104
5	ASHOKLEY	1	2	3	4	5	16	137	177	10	50	93	99	104
6	EQUITAS	10	50	93	99	5	102	110	122	9	10	11
7	L&TFH	11	12	13	14	15	16	17	18	19	20	21	22	23
8

Worksheet: Sheet1

If column J has data in actual file.xlsx then match column B of actual file.xlsx with column A of sheet 1 of 2.xlsx and if it matches then double the value of that row of 2.xlsx

After

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

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Stock Name	data	data	data	data	data	data	data	data	data	data	data	data	data	data
2	ACC	100	108	120	128	134	151	6534	30	90	97	103
3	ADANIENT	101	109	121	127	135	122	782	40	92	98
4	ADANIPORTS	102	110	122	16	137	177	10	50	93	99	104
5	ASHOKLEY	2	4	6	8	10	32	274	354	20	100	186	198	208
6	EQUITAS	20	100	186	198	10	204	220	244	18	20	22
7	L&TFH	22	24	26	28	30	32	34	36	38	40	42	44	46
8

Worksheet: Sheet2

Note: I think your supplied After is wrong! - L&TFH should not be considered from Actual File.xlsx, because J of that row is not 1

Macro for last post

Code:

---

Sub CopyPaste20Q2()  ' Question 2  https://excelfox.com/forum/showthread.php/2494-Copy-and-paste-of-data-if-matches
'    https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13388&viewfull=1#post13388
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

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
    For Cnt = 2 To 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
End Sub

---

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

---

---

Share 'Actual File.xlsx' : https://app.box.com/s/9dfaq1997whyyj0jq7ew30sixcmq9zpm
Share '2.xlsx' : https://app.box.com/s/ij24a4nmnnvi0h4qr13h49ro05aouatk
Share 'macro.xlsm' : https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt

Test ranges used to answer this post:
https://excelfox.com/forum/showthrea...ll=1#post13401

Before:

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

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ASHOKLEY	EQ	65	65.35	60.55	63.3	63.3		1		1	60	1.055	1.055	54	56.97
3	NSE	BANKBARODA	EQ	62.1	62.95	56.15	56.65	56.65		1		6	60	0.944167	5.665	54	50.985
4	NSE	BEL	EQ	66.15	66.75	62.4	65.65	65.65		1		6	60	1.094167	6.565	54	59.085
5	NSE	EQUITAS	EQ	82	82.05	71	73.05	73.05		1		1	60	1.2175	1.2175	54	65.745
6	NSE	FEDERALBNK	EQ	68	68.45	62.45	63.1	63.1		1		6	60	1.051667	6.31	54	56.79
7	NSE	GAIL	EQ	85	88.8	79.1	79.95	79.95		1		6	60	1.3325	7.995	54	71.955
8	NSE	IDFCFIRSTB	EQ	32.1	32.35	27.2	27.55	27.55				1	60	0.459167	0.459167	54	24.795
9	NSE	IOC	EQ	93	93.65	87.25	87.9	87.9				1	60	1.465	1.465	54	79.11
10	NSE	L&TFH	EQ	90	91.55	80.5	81.65	81.65				6	51	1.60098	9.605882	54	86.45294
11

Worksheet: Sheet1 (2)

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

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O
1	Stock Name	data	data	data	data	data	data	data	data	data	data	data	data	data	data
2	ACC	100	108	120	128	134	151	6534	30	90	97	103
3	ADANIENT	101	109	121	127	135	122	782	40	92	98
4	ADANIPORTS	102	110	122	16	137	177	10	50	93	99	104
5	ASHOKLEY	1	2	3	4	5	16	137	177
6	ANJALIPHARMA	10	50	93	99	5	102	110	122	9	10	11
7	SUNTECK	11	12	13	14	15	16	17	18	19	20	21	22	23
8

Worksheet: Sheet1 (5)

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

Row\Col	O	P	Q	R	S
6	6.31	54	56.79
7	7.995	54	71.955	Total Fund Amount	8387.320769
8	0.459167	54	24.795	Current Fund Amount	9000
9	1.465	54	79.11	Fund Allocated	8000
10	9.605882	54	86.45294	Profit Amount	1000
11		Sum is	551.8879

Worksheet: Sheet1 (2)

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

Row\Col	Q
2	56.97
3	50.985
4	59.085
5	65.745
6	56.79
7	71.955
8	24.795
9	79.11
10	86.45294
11	=SUM(Q2:Q10)

Worksheet: Sheet1 (2)


In this example sum of column Q is less than Range S10 value so nothing is done

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

---

Just testing
ignore all this

C:\Users

ror Resume Next
Set WB1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.x ls")
If Err <> 0 Then

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


Calculate 2% of colum H & column I & considered the greater number between them
column S should be positive, so don’t considere the no. which are negative
& if column S is lower than that 2% of column H or Column I (whichever is greater )then put -1
vba macro will be placed in a seperate file , sheet name can be anything, all files are located in different place
example
the U2 cell will become -1 after runing the macro

Code:

---

Sub CalculationByPercentageAndConditionallyPutingTheData() '  https://excelfox.com/forum/showthread.php/2499-calculation-by-percentage-and-conditionally-puting-the-data?p=13423&viewfull=1#post13423
Rem worksheets info
'  ap.xls
Dim Wbap As Workbook
 Set Wbap = Workbooks("ap.xls")
Dim Wsap As Worksheet
 Set Wsap = Wbap.Worksheets.Item(1)
Dim Lrap As Long: Let Lrap = Wsap.Range("B" & Wsap.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. )
Dim Arrap As Variant: Let Arrap = Wsap.Range("A1:Y" & Lrap & "").Value2
' 1b) Evaluate range H and I at 2%  -    Calculate 2% of colum H & column I
Dim arrH2pc() As Variant, arrI2pc() As Variant
 Let arrH2pc() = Evaluate("=2/100*H2:H" & Lrap & "")
 Let arrI2pc() = Evaluate("=2/100*I2:I" & Lrap & "")

Rem 2
Dim arrS() As Variant: Let arrS() = Wsap.Range("S1:S" & Lrap & "").Value2
Dim arrU() As Variant: Let arrU() = Wsap.Range("U1:U" & Lrap & "").Value2
Dim Cnt As Long
    For Cnt = 2 To Lrap
        If arrS(Cnt, 1) >= 0 Then
        Dim BgstHI As Double          '            colum H & column I & considered the greater number between them
        Let BgstHI = arrH2pc(Cnt - 1, 1)  '                                                                                                                        Cnt - 1  is  because our arrays for the H and I columns start at row 2 , so the indices will be one less than the roe to which they apply . I chose to do this to avoid trying to get 2% of the header , as that would error
            If arrH2pc(Cnt - 1, 1) < arrI2pc(Cnt - 1, 1) Then Let BgstHI = arrI2pc(Cnt - 1, 1) '  If I column is largest, use that, otherwise H will be taken  NOTE: H will be taken if the H and I columnns are equal
            If arrS(Cnt, 1) < BgstHI Then Let arrU(Cnt, 1) = -1
        Else ' S < 0
        '  column S should be positive, so don’t considere the no. which are negative
        End If
    Next Cnt
   
Rem 3 paste out
 Let Wsap.Range("U1:U" & Lrap & "").Value2 = arrU()
End Sub

---

arrHISU.JPG : https://imgur.com/uunxENf
Attachment 2954

---

Share ‘macro.xlsm’ : https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt
Share ‘ap.xls’ : https://app.box.com/s/pq6nqkfilk2xs5lf19ozcpx081rp47vs

macro for this post http://www.eileenslounge.com/viewtop...268809#p268809

Code:

---

'                                                                              From vixer zyxw1234 Avinash : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629    DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic                          Excel File, https://app.box.com/s/yyzt8ywwpkkn8vxtxumalp7eg3888jnu  Sample1.xlsx
Sub TextFileToExcel()  '  http://www.eileenslounge.com/viewtopic.php?p=268809#p268809
Rem 1 Workbooks,  Worksheets info
Dim Wb As Workbook, Ws As Worksheet
 Set Wb = Workbooks("Sample1.xlsx") ' CHANGE TO SUIT
 Set Ws = Wb.Worksheets.Item(1)    ' first worksheet
Dim lr As Long: Let lr = Ws.Range("A" & Ws.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. )
Dim NxtRw As Long
    If lr = 1 And Ws.Range("A1").Value = "" Then
    Let NxtRw = 1      '  If there is no data in the worksheet we want the first row to be the start row
    Else
    Let NxtRw = lr + 1 ' If there is data in the worksheet, we ant the data to be posted after the last used row
    End If
Rem 2 Text file info
' 2a) get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
 Let PathAndFileName = ThisWorkbook.Path & "\csv Text file Chaos\" & "DF.txt"  '    CHANGE TO SUIT  From vixer zyxw1234  : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629    DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine )
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1    '  +1 is nedeed as the  Split Function  returns indicies 0 1 2 3 4 5  etc...
' we can now make an array for all the rows, and we know our columns are A-J = 10 columns
Dim arrOut() As String: ReDim arrOut(1 To RwCnt, 1 To 10)

Rem 3 An array is built up by _....
Dim Cnt As Long
    For Cnt = 1 To RwCnt '              _.. considering each row of data
    Dim arrClms() As String
    Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare)  '  ___.. splitting each row into columns by splitting by the comma
    Dim Clm As Long  '
        For Clm = 1 To UBound(arrClms()) + 1
        Let arrOut(Cnt, Clm) = arrClms(Clm - 1)
        Next Clm
    Next Cnt

Rem 4  Finally the array is pasted to the worksheet at the next free row
 Let Ws.Range("A" & NxtRw & "").Resize(RwCnt, 10).Value = arrOut()
End Sub

---

---

Share ‘sample1.xlsx’ : https://app.box.com/s/r0tc0hkwoxrqjsqfu4gh7eqyy5jmqlg2
Share ‘macro.xlsm’ : https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt

In support of this Thread https://excelfox.com/forum/showthrea...3427#post13427

If column H of 1.xls is greater than column D of 1.xls then calculate 1% of column D of 1.xls & add it to column D of 1.xls and compare column D of 1.xls with column I of 1.xls & if column D of 1.xls is greater than column I of 1.xls then see column I and match column I of of 1.xls with column B of Alert..csv & if it matches then delete that entire row of Alert..csv
If column H of 1.xls is lower than column D of 1.xls then calculate 1% of column D of 1.xls & subtract it to column D of 1.xls and compare column D of 1.xls with column I of 1.xls & if column D of 1.xls is lower than column I then see column I of 1.xls and match column I of of 1.xls with column B of Alert..csv & if it matches then delete that entire row of Alert..csv

Excel File:
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ACC	EQ	1172	1240	1161.6	1227.1	1227.1	22
3	NSE	ADANIENT	EQ	138	141.2	136.6	138.1	140	25
4	NSE	ADANIPORTS	EQ	315	315	306.55	310.6	312	15083
5	NSE	ADANIPOWER	EQ	33.5	34.5	32.85	33	33.2	17388
6	NSE	AMARAJABAT	EQ	600	613.5	586.9	592.55	592.55	100
7	NSE	ASIANPAINT	EQ	1568.8	1625	1555.4	1617.9	1617.9	236

Worksheet: 1-Sheet1 24Mai

Text File:

Code:

---

NSE,236,6,>,431555,A,,,,,GTT
NSE,25,6,>,431555,A,,,,,GTT
NSE,15083,6,>,431555,A,,,,,GTT
NSE,17388,6,>,431555,A,,,,,GTT
NSE,100,6,>,431555,A,,,,,GTT
NSE,22,6,>,431555,A,,,,,GTT
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,Entire row of row 3 & row 4 both will be deleted after runing the macro,,,,,

---

Row in 1.xls
2	Column H is > column D Column D + 1% is > Column I 22 is matched to last line of data in Text File. So last line in data File should be removed.
3	Column H is > column D Column D + 1% is > Column I 25 is matched to second line of data in Text File. So thisline in data File should be removed.
4	Column H is < Column D Column D - 1% is < Column I 15083 is matched to third line of Text File. So this line is to be deleted
5	Column H is < Column D Column D - 1% is < Column I 17388 is matched to forth line of Text File. So this line is to be deleted
6	Column H is < Column D Column D - 1% is not < Column I so no match to be done , nothing more to be done
7	Column H is > column D Column D + 1% is > Column I 236 is matched to first line of data in Text File. So first line in data File should be removed.

Text File after

Code:

---

NSE,100,6,>,431555,A,,,,,GTT
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,,,,,,
,,,,,Entire row of row 3 & row 4 both will be deleted after runing the macro,,,,,

---

Macro solution for this post: https://excelfox.com/forum/showthrea...3427#post13427

Code:

---

'  https://excelfox.com/forum/showthread.php/2500-Conditionally-delete-entire-row-with-calculation-within-files?p=13427#post13427

Sub VBARemoveTextFileLineBasedOnExcelFileConditions()
Rem 1 Workbook, Worksheet info ( Excel File )
Dim Wb As Workbook, Ws As Worksheet
 Set Wb = Workbooks("1.xls") ' CHANGE TO SUIT
 Set Ws = Wb.Worksheets.Item(1)
Dim arrWs() As Variant: Let arrWs() = Ws.Range("A1").CurrentRegion.Value2
Dim Lr As Long: Let Lr = UBound(arrWs(), 1)
Rem 2 text File Info, Import into Excel
' 2a) get the text file as a long single string
Dim FileNum As Long: Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
 Let PathAndFileName = ThisWorkbook.Path & "\csv Text file Chaos\" & "Alert 24 Mai..csv"  ' CHANGE TO SUIT    From vixer  : https://excelfox.com/forum/showthread.php/2500-Conditionally-delete-entire-row-with-calculation-within-files?p=13427#post13427    Share ‘Alert 24 Mai..csv’  https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine )
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1    '  +1 is nedeed as the  Split Function  returns indicies 0 1 2 3 4 5  etc...
'  Alert 24 MaiDotDotcsvBefore.JPG  :  https://imgur.com/jSZV7Bt , https://imgur.com/ckS9Rzq
' 2c) ' we can now make an array for all the rows, and we know our columns are A-K = 11 columns
Dim arrIn() As String: ReDim arrIn(1 To RwCnt, 1 To 11)
Dim Cnt As Long
    For Cnt = 1 To RwCnt '              _.. considering each row of data
    Dim arrClms() As String
    Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare)  '  ___.. splitting each row into columns by splitting by the comma
    Dim Clm As Long  '
        For Clm = 1 To UBound(arrClms()) + 1
        Let arrIn(Cnt, Clm) = arrClms(Clm - 1)
        Next Clm
    Next Cnt
'  arrIn.jpg : https://imgur.com/agGbjHv
' 2d) second column in text file
Dim Clm2() As Variant: Let Clm2() = Application.Index(arrIn(), 0, 2) '    https://excelfox.com/forum/showthread.php/1111-VBA-Trick-of-the-Week-Slicing-an-Array-Without-Loop-%e2%80%93-Application-Index    Clm2.jpg :  https://imgur.com/Z6jYp3V

Rem 3 Do it
Dim IndDel As String: Let IndDel = " "  ' for indices to be deleted from rows out array  ''_-  an extra " " at the beginning : A spacee before means I will always get a corrent check of a number in the string
    For Cnt = 2 To Lr ' considering each data row in  1.xls
    Dim D1pc As Double ' for  calculate 1% of column D of 1.xls
    Dim MtchRes As Variant ' for match column I of of 1.xls with second data column of text file Alert..csv  Clm2()
        If arrWs(Cnt, 8) > arrWs(Cnt, 4) Then      '    If column H of 1.xls is greater than column D of 1.xls then
        Let D1pc = 1 / 100 * arrWs(Cnt, 4) ' calculate 1% of column D of 1.xls .._
        Let arrWs(Cnt, 4) = arrWs(Cnt, 4) + D1pc '              _.. & add it to column D of 1.xls
            If arrWs(Cnt, 4) > arrWs(Cnt, 9) Then ' If column D of 1.xls is greater than column I of 1.xls
            Let MtchRes = Application.Match(CStr(arrWs(Cnt, 9)), Clm2(), 0) ' match column I of of 1.xls with second column data of text file of Alert..csv
                If IsError(MtchRes) Then
                ' no match do nothing
                Else
                Let IndDel = IndDel & MtchRes - 1 & " " ' add an indicee of a row to be deleted
                End If
            Else
            ' column D of 1.xls is not greater than column I of 1.xls
            End If
       
        ElseIf arrWs(Cnt, 8) < arrWs(Cnt, 4) Then  '    If column H of 1.xls is lower than column D of 1.xls then
        Let D1pc = 1 / 100 * arrWs(Cnt, 4) ' calculate 1% of column D of 1.xls .._
        Let arrWs(Cnt, 4) = arrWs(Cnt, 4) - D1pc  '  &          _..  subtract it to column D of 1.xls
            If arrWs(Cnt, 4) < arrWs(Cnt, 9) Then ' If column D of 1.xls is lower than column I of 1.xls
            Let MtchRes = Application.Match(CStr(arrWs(Cnt, 9)), Clm2(), 0) ' match column I of of 1.xls with second column data of text file of Alert..csv
                If IsError(MtchRes) Then
                ' no match do nothing
                Else
                Let IndDel = IndDel & MtchRes - 1 & " " ' add an indicee of a row to be deleted
                End If
            Else
            ' column D of 1.xls is not lower than column I of 1.xls
            End If
        Else
        ' column H of 1.xls is = column D of 1.xls
        End If ' end of column H compare to column D
    Next Cnt

Rem 4 remake the text file row array
Dim arrRwsOut() As String  ' array for making a new text file
Dim RwsOut As Long ' for row count in modified outpur rows array, arrrwsOut()
Dim RwDelCnt As Long: Let RwDelCnt = (Len(IndDel) - Len(Replace(IndDel, " ", "", 1, -1, vbBinaryCompare))) - 1 '  -1 because of an extra " " at the beginning - ''_-  an extra " " at the beginning : A spacee before means I will always get a corrent check of a number in the string
ReDim arrRwsOut(0 To UBound(arrRws()) - RwDelCnt)
    For Cnt = 0 To UBound(arrRws())
    If InStr(1, IndDel, " " & Cnt & " ", vbBinaryCompare) = 0 Then
      Let arrRwsOut(RwsOut) = arrRws(Cnt)
      Let RwsOut = RwsOut + 1
    Else
    ' do nothing since we are at a row to be deleted
    End If
    Next Cnt

Rem 5 remake the text file
'5a) make a new text file string
Dim strTotalFile As String
 Let strTotalFile = Join(arrRwsOut(), vbCr & vbLf)
'5b) make new file
Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
 Open ThisWorkbook.Path & "\csv Text file Chaos\" & "Alert 24 Mai Out..csv" For Output As #FileNum  ' CHANGE TO SUIT  ' Will be made if not there
 Print #FileNum, strTotalFile
 Close #FileNum

End Sub


---

---

Text File given:
Share ‘Alert 24 Mai..csv’ : https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt

New text file made after running macro:
Share ‘Alert 24 Mai Out..csv’ : https://app.box.com/s/yseazrdyfloij4ktrhy4ejdpzl0cx02e

Share ‘1.xls’ : https://app.box.com/s/38aoip5xi7018y9syt0xe4g04u95l6xk

Share ‘macro.xlsm’ : https://app.box.com/s/z358r7tbc9hzthi539dlj49jsf4gyg8p

test asdsdklj




aslkhSLHDSlhdslhfslkhasklh




ASFJALSKJFASLKJFASLKJFASLKFJALKSJFSLKAJ

lSHFLSHFHSLHF

assfhshffhsfskfh

In support of answer for this post.
https://excelfox.com/forum/showthrea...3470#post13470

Text file supplied Sample2.csv ( Avinash : https://excelfox.com/forum/showthrea...ll=1#post13470
sample2 ef 5 June.csv : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
sample2.csv : https://app.box.com/s/0ej2h41g9fvm94cflf2j60a8o6p3334t )

Code:

---

NSE,101010,6,<,12783,A,,,,,GTT,,,,,,,,,,,,,
NSE,22,6,<,12783,A,,,,,GTT,,,,,,,,,,,,,
NSE,17388,6,<,12783,A,,,,,GTT,,,,,,,,,,,,,
,100,,,,,,,,,,,,,,,,,,,,,,
,25,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,Only for understanding purpose,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,Before runing the macro,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,NSE,101010,6,<,12783,A,,,,,GTT
,,,,,,,,,,,,,NSE,22,6,<,12783,A,,,,,GTT
,,,,,,,,,,,,,NSE,17388,6,<,12783,A,,,,,GTT
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,After runing the macro,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,,,,,,,,,,,
,,,,,,,,,,,,,NSE,101010,6,<,12783,A,,,,,GTT
,,,,,,,,,,,,,NSE,22,6,<,12783,A,,,,,GTT
,,,,,,,,,,,,,NSE,17388,6,<,12783,A,,,,,GTT
,,,,,,,,,,,,,,100,,,,,,,,,
,,,,,,,,,,,,,,25,,,,,,,,,

---

Open in/ with Excel: ( Like: this: https://imgur.com/7pAaLVx , https://excelfox.com/forum/showthrea...ll=1#post13440 , for example with text editor
OpenSample2_csvManually with Excel.JPG : https://imgur.com/e7CxxpV)
Attachment 2963

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

Row\Col	A	B
1	NSE,101010,6,<,12783,A,,,,,GTT,,,,,,,,,,,,,
2	NSE,22,6,<,12783,A,,,,,GTT,,,,,,,,,,,,,
3	NSE,17388,6,<,12783,A,,,,,GTT,,,,,,,,,,,,,
4	,100,,,,,,,,,,,,,,,,,,,,,,
5	,25,,,,,,,,,,,,,,,,,,,,,,
6	,,,,,,,,,,,,,,,,,,,,,,,
7	,,,,,,,,,,,,,,,,,,,,,,,
8	,,,,,,,,,,,,,,,,,,,,,,,
9	,,,,,,,,,,,,,,,,,,,,,,,
10	,,,,,,,,,,,,,,,,,,,,,,,
11	,,,,,,,,,,,,,,,,,,,,,,,
12	,,,,,,,,,,,,,,,,,,,,,,,
13	,,,,,,,,,,,,,,,,,,,,,,,
14	,,,,,,,,,,,,,,,,,,,,,,,
15	,,,,,,,,,,,,,,,,,,,,,,,
16	,,,,,,,,,,,,,Only for understanding purpose,,,,,,,,,,
17	,,,,,,,,,,,,,,,,,,,,,,,
18	,,,,,,,,,,,,,Before runing the macro,,,,,,,,,,
19	,,,,,,,,,,,,,,,,,,,,,,,
20	,,,,,,,,,,,,,NSE,101010,6,<,12783,A,,,,,GTT
21	,,,,,,,,,,,,,NSE,22,6,<,12783,A,,,,,GTT
22	,,,,,,,,,,,,,NSE,17388,6,<,12783,A,,,,,GTT
23	,,,,,,,,,,,,,,,,,,,,,,,
24	,,,,,,,,,,,,,,,,,,,,,,,
25	,,,,,,,,,,,,,,,,,,,,,,,
26	,,,,,,,,,,,,,,,,,,,,,,,
27	,,,,,,,,,,,,,After runing the macro,,,,,,,,,,
28	,,,,,,,,,,,,,,,,,,,,,,,
29	,,,,,,,,,,,,,,,,,,,,,,,
30	,,,,,,,,,,,,,,,,,,,,,,,
31	,,,,,,,,,,,,,NSE,101010,6,<,12783,A,,,,,GTT
32	,,,,,,,,,,,,,NSE,22,6,<,12783,A,,,,,GTT
33	,,,,,,,,,,,,,NSE,17388,6,<,12783,A,,,,,GTT
34	,,,,,,,,,,,,,,100,,,,,,,,,
35	,,,,,,,,,,,,,,25,,,,,,,,,
36

Worksheet: sample2


Open with Excel VBA:

Code:

---

Sub OpenVBASample2_csv_5June() '  https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13476&viewfull=1#post13476
' Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Sample2.csv"
 Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2.csv" ' CHANGE TO SUIT
End Sub
' see next post :  https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13476&viewfull=1#post13476

---

see next post : https://excelfox.com/forum/showthrea...ll=1#post13476

Code:

---

Sub OpenVBASample2_csv_5June() '
' Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Sample2.csv"
 Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2.csv" ' CHANGE TO SUIT
End Sub

---

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

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L	M	N	O	P	Q	R	S	T	U	V	W	X
1	NSE	101010	6	<	12783	A					GTT
2	NSE	22	6	<	12783	A					GTT
3	NSE	17388	6	<	12783	A					GTT
4		100
5		25
6
7
8
9
10
11
12
13
14
15
16														Only for understanding purpose
17
18														Before runing the macro
19
20														NSE	101010	6	<	12783	A					GTT
21														NSE	22	6	<	12783	A					GTT
22														NSE	17388	6	<	12783	A					GTT
23
24
25
26
27														After runing the macro
28
29
30
31														NSE	101010	6	<	12783	A					GTT
32														NSE	22	6	<	12783	A					GTT
33														NSE	17388	6	<	12783	A					GTT
34															100
35															25

Worksheet: sample2


Note : Sometimes Excel manually or Excel VBA will open .csv file and put values across column cells. but also sometimes Excel manually or Excel VBA will open .csv file and put all values and commas in first cell

Sample2After.csv

Code:

---

NSE,101010,6,<,12783,A,,,,,GTT
NSE,22,6,<,12783,A,,,,,GTT
NSE,17388,6,<,12783,A,,,,,GTT
,100,,,,,,,,,,
,25,,,,,,,,,,

---

In Excel ( open manually )
Open Sample2_csv Manually with Excel.JPG : https://imgur.com/9QNhxrA
_____ Workbook: Sample2After.csv ( Using Excel 2007 32 bit )

Row\Col	A	B
1	NSE,101010,6,<,12783,A,,,,,GTT
2	NSE,22,6,<,12783,A,,,,,GTT
3	NSE,17388,6,<,12783,A,,,,,GTT
4	,100,,,,,,,,,,
5	,25,,,,,,,,,,
6

Worksheet: Sample2After





In Excel VBA

Code:

---

_ Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2After.csv" ' CHANGE TO SUIT

---

_____ Workbook: Sample2After.csv ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L
1	NSE	101010	6	<	12783	A					GTT
2	NSE	22	6	<	12783	A					GTT
3	NSE	17388	6	<	12783	A					GTT
4		100
5		25
6

Worksheet: Sample2After



Note : Sometimes Excel manually or Excel VBA will open .csv file and put values across column cells. but also sometimes Excel manually or Excel VBA will open .csv file and put all values and commas in first cell

---

---

Code:

---

Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFileToRwCnt)


---

Code:

---

"NSE" & Chr(44) & "101010" & Chr(44) & "6" & Chr(44) & Chr(60) & Chr(44) & "12783" & Chr(44) & "A" & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & "GTT" & vbCr & vbLf & "NSE" & Chr(44) & "22" & Chr(44) & "6" & Chr(44) & Chr(60) & Chr(44) & "12783" & Chr(44) & "A" & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & "GTT" & vbCr & vbLf & "NSE" & Chr(44) & "17388" & Chr(44) & "6" & Chr(44) & Chr(60) & Chr(44) & "12783" & Chr(44) & "A" & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & "GTT" & vbCr & vbLf & Chr(44) & "100" & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & vbCr & vbLf & Chr(44) & "25" & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & Chr(44) & vbCr & vbLf

---

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

Code:

---

'    https://excelfox.com/forum/showthread.php/2505-copy-paste-the-data-if-condition-matches?p=13470#post13470
Sub VBAAppendDataToTextFileLineBasedOnTheTextFileAndExcelFileConditions()
Rem 1 Workbook, Worksheet info ( Excel File )
Dim Wb As Workbook, Ws As Worksheet
' Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Sample1.xls")
' Set Wb = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & "Sample1.xls")
 Set Wb = Workbooks("1.xls") '  Workbooks("Sample1.xls") ' CHANGE TO SUIT
 Set Ws = Wb.Worksheets.Item(1)
Dim arrWs() As Variant: Let arrWs() = Ws.Range("A1").CurrentRegion.Value2
Dim Lr As Long: Let Lr = UBound(arrWs(), 1)
Rem 2 text File Info, Import into Excel Array
Dim PathAndFileName As String, TotalFile As String
' Let PathAndFileName = ThisWorkbook.Path & "\" & "Alert 24 Mai..csv"    '
 Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "Sample2.csv" ' "sample2 ef 5 June.csv"    ' CHANGE TO SUIT    From Avinash  : https://excelfox.com/forum/showthread.php/2505-copy-paste-the-data-if-condition-matches?p=13470&viewfull=1#post13470  sample2 ef 5 June.csv : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
' 2a)(i) Determine rows (records) wanted, based on ... First column(field) not being empty
Dim RwCnt As Long, TextFileLineIn As String
Dim FileNum As Long: Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
 Open PathAndFileName For Input As #FileNum 'Open Route to data
 Line Input #FileNum, TextFileLineIn  '  First line
    Do While Left(TextFileLineIn, 4) = "NSE," ' For text file lines like  NSE,101010,6,<,12783,A,,,,,GTT
    Let RwCnt = RwCnt + 1
    Line Input #FileNum, TextFileLineIn '  next line in text file
    Loop
 Close #FileNum
' 2a)(ii) get the text file as a long single string
 Let FileNum = FreeFile(1)
 Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
 Let TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length
 Get #FileNum, , TotalFile
 Close #FileNum
' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine )
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
'Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1    '  +1 is nedeed as the  Split Function  returns indicies 0 1 2 3 4 5  etc...
'  Alert 24 MaiDotDotcsvBefore.JPG  :  https://imgur.com/jSZV7Bt , https://imgur.com/ckS9Rzq
' 2c) ' we can now make an array for all the rows, and we know our columns are A-K = 11 columns
Dim arrIn() As String: ReDim arrIn(1 To RwCnt, 1 To 11)
Dim Cnt As Long
    For Cnt = 1 To RwCnt '              _.. considering each row of data but only those up to Rwcnt
    Dim arrClms() As String
    Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare)  '  ___.. splitting each row into columns by splitting by the comma
    Dim Clm As Long  '
        For Clm = 1 To 11
        'For Clm = 1 To UBound(arrClms()) + 1
        Let arrIn(Cnt, Clm) = arrClms(Clm - 1)
        Dim TruncRw As String                              '_-
        Let TruncRw = TruncRw & arrIn(Cnt, Clm) & ","    '_- The idea of this is a bodge to  get rid of a lot of extra ,,,,,,, if we have empty cells being used, as in Avinash original -  sample2.csv : https://app.box.com/s/0ej2h41g9fvm94cflf2j60a8o6p3334t  -  https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13475&viewfull=1#post13475
        Next Clm
    Let arrRws(Cnt - 1) = Left(TruncRw, Len(TruncRw) - 1) '_- take off the last ,
    Let TruncRw = ""
    Next Cnt
' 2d) Re make text string of just rows to RwCnt
ReDim Preserve arrRws(0 To RwCnt - 1)
Dim TotalFileToRwCnt As String
 Let TotalFileToRwCnt = Join(arrRws(), vbCr & vbLf) & vbCr & vbLf ' This is effectively our long string text file and an extra final carriage return and line feed
' 2d) second column in text file, up to RwCnt
Dim Clm2() As Variant: Let Clm2() = Application.Index(arrIn(), 0, 2) '    https://excelfox.com/forum/showthread.php/1111-VBA-Trick-of-the-Week-Slicing-an-Array-Without-Loop-%e2%80%93-Application-Index    Clm2Sample2csv.JPG :  https://imgur.com/DYYAl3z

Rem 3 Do it
    For Cnt = 2 To Lr ' considering each data row in  Sample1.xls
    ' ( If column K of sample1.xls is greater than Column D of sample1.xls & Column H of sample1.xls is Greater than column K of sample1.xls ) or ( If column K of sample1.xls is lower than Column D of sample1.xls & Column H of sample1.xls is lower than column K of sample1.xls ) Then
    '                          Condition 1)                                    or        Condition 2)
        If (arrWs(Cnt, 11) > arrWs(Cnt, 4) And arrWs(Cnt, 8) > arrWs(Cnt, 11)) Or (arrWs(Cnt, 11) < arrWs(Cnt, 4) And arrWs(Cnt, 8) < arrWs(Cnt, 11)) Then
        Dim MtchRes As Variant ' for match column I of of Sample1.xls with second data column of text file  Sample2.csv  Clm2()
        Let MtchRes = Application.Match(CStr(arrWs(Cnt, 9)), Clm2(), 0) ' match column I of of 1.xls with second column data of text file of Alert..csv
        ' Match Column I of sample1.xls with second field values (column B) of sample2.csv
            If Not IsError(MtchRes) Then  ' if it is there then do nothing
            '  match obtsained do nothing
            Else '  it is not present  paste the column I data of sample1.xls to append second field values (column B) of sample2.csv
            Let TotalFileToRwCnt = TotalFileToRwCnt & "," & arrWs(Cnt, 9) & ",,,,,,,,,," & vbCr & vbLf ' make the single text string for the output text file
            End If

        Else
        ' Neither of the 2 conditions are met so do nothing
        End If
   
    Next Cnt

Rem 5 remake the text file
''5a) make a new text file string
'Dim strTotalFile As String
' Let strTotalFile = Join(arrRwsOut(), vbCr & vbLf)
'5b) make new file
Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
 Open ThisWorkbook.Path & "\" & "Sample2After.csv" For Output As #FileNum  ' CHANGE TO SUIT  ' Will be made if not there
 Print #FileNum, TotalFileToRwCnt '                      strTotalFile
 Close #FileNum
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFileToRwCnt)

'Rem 6 Check File in Excel VBA open
'' Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Sample2.csv"
' Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2After.csv" ' CHANGE TO SUIT
'
 
End Sub

---

---

sample2.csv : https://app.box.com/s/0ej2h41g9fvm94cflf2j60a8o6p3334t
Sample1.xls : https://app.box.com/s/xh58fgjl74w06hvsd53jriqkohdm6a3q
macro.xlsm : https://app.box.com/s/z358r7tbc9hzthi539dlj49jsf4gyg8p
Sample2After.csv : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
vba.xlsm : https://app.box.com/s/juekenyll42z84j6ms7qonzsngnugoyo

Macro for this post
https://excelfox.com/forum/showthrea...-condition-met

Code:

---

Sub VBAAppendDataToExcelFileRowBasedOnTwoExcelFileConditions2()  '          https://excelfox.com/forum/showthread.php/2517-Copy-and-paste-the-data-if-condition-met  Previous macro where second file is  .csv  text file                https://excelfox.com/forum/showthread.php/2505-copy-paste-the-data-if-condition-matches?p=13616&viewfull=1#post13616
Rem 1 sample1.xls
Dim Wb1 As Workbook, Ws1 As Worksheet
' Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Sample1.xls")
' Set Wb = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & "Sample1.xls")
 Set Wb1 = Workbooks("Sample1.xls")
 Set Ws1 = Wb1.Worksheets.Item(1)
Dim arrWs1() As Variant: Let arrWs1() = Ws1.Range("A1").CurrentRegion.Value2
Dim Lr1 As Long: Let Lr1 = UBound(arrWs1(), 1)
Rem 2 sample2.xlsx
Dim Wb2 As Workbook, Ws2 As Worksheet
 Set Wb2 = Workbooks("Sample2.xlsx")
 Set Ws2 = Wb2.Worksheets.Item(1)
Dim RwCnt2 As Long: Let RwCnt2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row
Dim NxtRw As Long: Let NxtRw = RwCnt2 + 1 ' next free row in sample2.xlsx
' 2d) second column in sample2.xlsx up maximum size of  sample1.xls  - that will be the biggest size needed
Dim Clm2() As Variant: Let Clm2() = Ws2.Range("B1:B" & Lr1 & "").Value  '  Clm2Sample2xlsx.JPG

Rem 3 Do it
Dim Cnt As Long
    For Cnt = 2 To Lr1 ' considering each data row in  Sample1.xls
    ' ( If column K of sample1.xls is greater than Column D of sample1.xls & Column H of sample1.xls is Greater than column K of sample1.xls ) or ( If column K of sample1.xls is lower than Column D of sample1.xls & Column H of sample1.xls is lower than column K of sample1.xls ) Then
    '                          Condition 1)                                    or        Condition 2)
        If (arrWs1(Cnt, 11) > arrWs1(Cnt, 4) And arrWs1(Cnt, 8) > arrWs1(Cnt, 11)) Or (arrWs1(Cnt, 11) < arrWs1(Cnt, 4) And arrWs1(Cnt, 8) < arrWs1(Cnt, 11)) Then
        Dim MtchRes As Variant ' for match column I of of Sample1.xls with second data column of  Sample2.xls Clm2()
        Let MtchRes = Application.Match(arrWs1(Cnt, 9), Clm2(), 0) ' match column I of of 1.xls with second column data of sample2.xlsx
        ' Match Column I of sample1.xls with second column (column B) of sample2.xlsx
            If Not IsError(MtchRes) Then  ' if it is there then do nothing
            '  match obtsained do nothing
            Else '  it is not present  paste the column I data of sample1.xls to second column values (column B) of sample2.xlsx
            Let Clm2(NxtRw, 1) = arrWs1(Cnt, 9)
                If NxtRw <> Lr1 Then Let NxtRw = NxtRw + 1 ' If we are not already at the maximum possible row in column B, Ws2 , then we need to adjust  NxtRw  for next possible missing match
            End If

        Else
        ' Neither of the 2 conditions are met so do nothing
        End If
   
    Next Cnt

Rem Paste out adjusted/ added to  Ws2 column B
 Ws2.Range("B1:B" & Lr1 & "").Value = Clm2()
End Sub

---

---

sample1.xls : https://app.box.com/s/xh58fgjl74w06hvsd53jriqkohdm6a3q
sample2.xlsx : https://app.box.com/s/np7kbvjydnyiu95pzyrgn76qi1uqg0ma
vba.xlsm : https://app.box.com/s/lf6otsrl42m6vxxvycjo04zidya6pd2m

Macro to answer this Thread
https://excelfox.com/forum/showthrea...ete-entire-row

Code:

---

Sub STEP9t() '  https://excelfox.com/forum/showthread.php/2520-Conditionally-compare-the-data-amp-delete-entire-row
Rem 1 Worksheets info
'1_1 sample1.xls
Dim Wb1 As Workbook, Ws1 As Worksheet
' Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Sample1.xls")
' Set Wb = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & "Sample1.xls")
 Set Wb1 = Workbooks("1.xls")
 Set Ws1 = Wb1.Worksheets.Item(1)
Dim arrWs1() As Variant: Let arrWs1() = Ws1.Range("A1").CurrentRegion.Value2
Dim Lr1 As Long: Let Lr1 = UBound(arrWs1(), 1)
Dim arrS1() As Variant 'Let arrS1() = Ws1.Range("A1").CurrentRegion.Value
Let arrS1() = Ws1.Range("A1:J" & Lr1 & "").Value ' Input data range
'1_2 Alert.xls
Dim Wb2 As Workbook, Ws2 As Worksheet
 Set Wb2 = Workbooks("Alert.xls")
 Set Ws2 = Wb2.Worksheets.Item(1)
Dim RwCnt2 As Long: Let RwCnt2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row
'1_2d) second column in Alert.xls
Dim Clm2() As Variant: Let Clm2() = Ws2.Range("B1:B" & RwCnt2 & "").Value

Rem 3
Dim Cnt As Long, MtchRes As Variant
    For Cnt = UBound(arrS1(), 1) To 2 Step -1 '  "row" count, Cnt
    Select Case arrS1(Cnt, 10) ' column I
      Case "BUY"  'If column J of 1.xls has buy then
        If arrS1(Cnt, 8) < arrS1(Cnt, 4) Then  ' column H of 1.xls is not greater than column D of 1.xls
        Let MtchRes = Application.Match(arrWs1(Cnt, 9), Clm2(), 0) ' match column I data of 1.xls with column B of alert.xls
            If IsError(MtchRes) Then
            ' no match result so do nothing
            Else
            Ws2.Range("A" & MtchRes & ":K" & MtchRes & "").Delete shift:=xlUp  ' delete that entire row of alert.xls
            End If:
        Else
        End If
      Case ""      ' If column J of 1.xls has a blank cell then
      Let MtchRes = Application.Match(arrWs1(Cnt, 9), Clm2(), 0) ' match column I data of 1.xls with column B of alert.xls
        If IsError(MtchRes) Then
        ' no match result so do nothing
        Else
        Ws2.Range("A" & MtchRes & ":K" & MtchRes & "").Delete shift:=xlUp  ' delete that entire row of alert.xls
        End If
      Case "SHORT"  'If column J is SHORT then
        If arrS1(Cnt, 8) > arrS1(Cnt, 4) Then ' column H of 1.xls is Greater than than column D
        Let MtchRes = Application.Match(arrWs1(Cnt, 9), Clm2(), 0) ' match column I data of 1.xls with column B of alert.xls
            If IsError(MtchRes) Then
            ' no match result so do nothing
            Else
            Ws2.Range("A" & MtchRes & ":K" & MtchRes & "").Delete shift:=xlUp  ' delete that entire row of alert.xls
            End If
        Else
        End If
    End Select
    Next Cnt

End Sub

---

---

macro.xlsm : https://app.box.com/s/z358r7tbc9hzthi539dlj49jsf4gyg8p
1.xls : https://app.box.com/s/38aoip5xi7018y9syt0xe4g04u95l6xk
Alert.xls : https://app.box.com/s/ectstkrcfnuozys9tmdd0qi3tdvyxb3w

Macro for this post:
https://excelfox.com/forum/showthrea...ata-if-matches

Code:

---

Sub AddColumnJValueInWs1basedOnMatchAndCritzeriaInWs2() ' https://excelfox.com/forum/showthread.php/2556-copy-and-paste-of-data-if-matches
Rem 1 Worksheets info
'1_1 sample1.xls
Dim Wb1 As Workbook, Ws1 As Worksheet
' Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Sample1.xls")
' Set Wb = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & "Sample1.xls")
 Set Wb1 = Workbooks("1.xls")
 Set Ws1 = Wb1.Worksheets.Item(1)
Dim arrWs1() As Variant: Let arrWs1() = Ws1.Range("A1").CurrentRegion.Value2
Dim Lr1 As Long: Let Lr1 = UBound(arrWs1(), 1)
'1_1b) data range
Dim arrS1() As Variant 'Let arrS1() = Ws1.Range("A1").CurrentRegion.Value
Let arrS1() = Ws1.Range("A1:J" & Lr1 & "").Value ' Input data range
'1_2 AlertCodes.xlsx
Dim WbA As Workbook, WsA4 As Worksheet
 Set WbA = Workbooks("AlertCodes.xlsx")
 Set WsA4 = WbA.Worksheets.Item(4)
Dim RwCnt4 As Long: Let RwCnt4 = WsA4.Range("A" & WsA4.Rows.Count & "").End(xlUp).Row
'1_2b) dataa range
Dim arrWsA4() As Variant: Let arrWsA4() = WsA4.Range("A1:K" & RwCnt4 & "").Value2
'1_2d) second column in Alertcodes.xlsx
Dim ClmB() As Variant: Let ClmB() = WsA4.Range("B1:B" & RwCnt4 & "").Value

Rem 3
Dim Cnt As Long
    For Cnt = 2 To Lr1 ' going down "rows" in 1.xls
    Dim MtchRes As Variant
    Let MtchRes = Application.Match(arrWs1(Cnt, 9), ClmB(), 0) '  match column I of 1.xls  with sheet4 of column B of Alertcodes.xlsx
        If IsError(MtchRes) Then
        ' do nothing - no match
        Else ' look at symbol in column D, 4th worksheet of AlertCodes.xlsx for that matched row in column D, 4th worksheet of AlertCodes.xlsx
            If arrWsA4(MtchRes, 4) = ">" Then ' If symbol is > then
            Let arrS1(Cnt, 10) = "SHORT" ' put SHORT in column J of 1.xls for the matched row
            ElseIf arrWsA4(MtchRes, 4) = "<" Then '  If symbol < then
            Let arrS1(Cnt, 10) = "BUY" ' put BUY in column J of 1.xls for the matched row
            Else
            End If
           
        End If
    Next Cnt

Rem 4 Paste back out arrS1()
 Let Ws1.Range("A1:J" & Lr1 & "").Value2 = arrS1()
End Sub


---

---

AlertCodes.xlsx : https://app.box.com/s/jwpjjut9wt3ej7dbns3269ftlpdr7xsm
1.xls : https://app.box.com/s/38aoip5xi7018y9syt0xe4g04u95l6xk
Vba.xlsm : https://app.box.com/s/lf6otsrl42m6vxxvycjo04zidya6pd2m

In support of these posts
https://excelfox.com/forum/showthrea...ll=1#post13617
https://excelfox.com/forum/showthrea...ll=1#post13470

sample2BEFORE.csv
NSE,101010,6,<,12783,A,,,,,GTT
NSE,22,6,<,12783,A,,,,,GTT
NSE,17388,6,<,12783,A,,,,,GTT

Code:

---

"NSE" & "," & "101010" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "22" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "17388" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf

---

Code:

---

"NSE" & "," & "101010" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" &
vbCr & vbLf & "NSE" & "," & "22" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" &
vbCr & vbLf & "NSE" & "," & "17388" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" &
vbCr & vbLf

---

sampLE2AFTER.csv
NSE,101010,6,<,12783,A,,,,,GTT
NSE,22,6,<,12783,A,,,,,GTT
NSE,17388,6,<,12783,A,,,,,GTT
,100,,,,,,,,,
,25,,,,,,,,,

Code:

---

"NSE" & "," & "101010" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "22" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "NSE" & "," & "17388" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & vbCr & vbLf & "," & "100" & "," & "," & "," & "," & "," & "," & "," & "," & "," & vbCr & vbLf & "," & "25" & "," & "," & "," & "," & "," & "," & "," & "," & "," & vbCr & vbLf

---

Code:

---

"NSE" & "," & "101010" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" &
vbCr & vbLf & "NSE" & "," & "22" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" &
vbCr & vbLf & "NSE" & "," & "17388" & "," & "6" & "," & Chr(60) & "," & "12783" & "," & "A" & "," & "," & "," & "," & "," & "GTT" &
vbCr & vbLf & "," & "100" & "," & "," & "," & "," & "," & "," & "," & "," & "," &
vbCr & vbLf & "," & "25" & "," & "," & "," & "," & "," & "," & "," & "," & "," &
vbCr & vbLf

---

---

https://excelfox.com/forum/showthrea...ll=1#post13617
sampLE2AFTER.csv : https://drive.google.com/file/d/1Tyf...gWwzZ3s43YxzwA
sample2BEFORE : https://drive.google.com/file/d/1X2M...vIqNATRC34o5hD


app.box.com
Share ‘sample2BEFORE.csv’ : https://app.box.com/s/d8lu7iatfv6h8spp9eru8asm3h4v4e4p
Share ‘Sample2After.csv’ : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu

---

Previous files:
sample2.csv : https://app.box.com/s/0ej2h41g9fvm94cflf2j60a8o6p3334t
Sample1.xls : https://app.box.com/s/xh58fgjl74w06hvsd53jriqkohdm6a3q
macro.xlsm : https://app.box.com/s/z358r7tbc9hzthi539dlj49jsf4gyg8p
Sample2After.csv : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
vba.xlsm : https://app.box.com/s/juekenyll42z84j6ms7qonzsngnugoyo

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

Code:

---

Sub VBAAppendDataToTextFileLineBasedOnTheTextFileAndExcelFileConditions2()  '  https://excelfox.com/forum/showthread.php/2505-copy-paste-the-data-if-condition-matches?p=13616&viewfull=1#post13616
Rem 1 Workbook, Worksheet info ( Excel File )
Dim Wb As Workbook, Ws As Worksheet
' Set Wb = Workbooks.Open(ThisWorkbook.Path & "\" & "Sample1.xls")
' Set Wb = Workbooks.Open(ThisWorkbook.Path & Application.PathSeparator & "Sample1.xls")
 Set Wb = Workbooks("1.xls") '  Workbooks("Sample1.xls") ' CHANGE TO SUIT
 Set Ws = Wb.Worksheets.Item(1)
Dim arrWs() As Variant: Let arrWs() = Ws.Range("A1").CurrentRegion.Value2
Dim LR As Long: Let LR = UBound(arrWs(), 1)
Rem 2 text File Info, Import into Excel Array
Dim PathAndFileName As String, TotalFile As String
' Let PathAndFileName = ThisWorkbook.Path & "\" & "Alert 24 Mai..csv"    '
 Let PathAndFileName = ThisWorkbook.Path & Application.PathSeparator & "sample2BEFORE.csv"  '  "sample2_9June.csv"    ' "sample2 8June.csv"  '  "Sample2.csv" ' "sample2 ef 5 June.csv"    ' CHANGE TO SUIT    From Avinash  : https://excelfox.com/forum/showthread.php/2505-copy-paste-the-data-if-condition-matches?p=13470&viewfull=1#post13470  sample2 ef 5 June.csv : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
' 2a)(i) Determine rows (records) wanted, based on ... First column(field) not being empty
Dim RwCnt As Long, TextFileLineIn As String
Dim FileNum As Long: Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
 Open PathAndFileName For Input As #FileNum 'Open Route to data
 Line Input #FileNum, TextFileLineIn  '  First line
    Do While Not EOF(FileNum) = True And Left(TextFileLineIn, 4) = "NSE," '  Left(TextFileLineIn, 4) = "NSE," ' For text file lines like  NSE,101010,6,<,12783,A,,,,,GTT that may have extra unwanted lines like in one Avinash uses stupidly for explanations
    Let RwCnt = RwCnt + 1 ' for first and subsequent lines given by below. ... but
    Line Input #FileNum, TextFileLineIn '  next line in text file
    Loop
    If EOF(FileNum) = True Then Let RwCnt = RwCnt + 1    '                  ... but if the last line I want is EOF, I will not catch it in the loop so must add a 1 here
 Close #FileNum
' 2a)(ii) get the text file as a long single string
 Let FileNum = FreeFile(1)
 Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
 Let TotalFile = Space(LOF(FileNum)) '....and wot recives it has to be a string of exactly the right length
 Get #FileNum, , TotalFile
 Close #FileNum
' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine )
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
'Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1    '  +1 is nedeed as the  Split Function  returns indicies 0 1 2 3 4 5  etc...
'  Alert 24 MaiDotDotcsvBefore.JPG  :  https://imgur.com/jSZV7Bt , https://imgur.com/ckS9Rzq
' 2c) ' we can now make an array for all the rows, and we know our columns are A-K = 11 columns
Dim arrIn() As String: ReDim arrIn(1 To RwCnt, 1 To 11)
Dim Cnt As Long
    For Cnt = 1 To RwCnt '              _.. considering each row of data but only those up to Rwcnt
    Dim arrClms() As String
    Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare)  '  ___.. splitting each row into columns by splitting by the comma
    Dim Clm As Long  '
        For Clm = 1 To 11
        'For Clm = 1 To UBound(arrClms()) + 1
        Let arrIn(Cnt, Clm) = arrClms(Clm - 1)
        Dim TruncRw As String                              '_-
        Let TruncRw = TruncRw & arrIn(Cnt, Clm) & ","    '_- The idea of this is a bodge to  get rid of a lot of extra ,,,,,,, if we have empty cells being used, as in Avinash original -  sample2.csv : https://app.box.com/s/0ej2h41g9fvm94cflf2j60a8o6p3334t  -  https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13475&viewfull=1#post13475
        Next Clm
    Let arrRws(Cnt - 1) = Left(TruncRw, Len(TruncRw) - 1) '_- take off the last ,
    Let TruncRw = ""                                      '_- so this can be used again for next line(row)
    Next Cnt
' 2d) Re make text string of just rows to RwCnt
ReDim Preserve arrRws(0 To RwCnt - 1)
Dim TotalFileToRwCnt As String
 Let TotalFileToRwCnt = Join(arrRws(), vbCr & vbLf) & vbCr & vbLf ' This is effectively our long string text file and an extra final carriage return and line feed
' 2d) second column in text file, up to RwCnt
Dim Clm2() As Variant: Let Clm2() = Application.Index(arrIn(), 0, 2) '    https://excelfox.com/forum/showthread.php/1111-VBA-Trick-of-the-Week-Slicing-an-Array-Without-Loop-%e2%80%93-Application-Index    Clm2Sample2csv.JPG :  https://imgur.com/DYYAl3z

Rem 3 Do it
    For Cnt = 2 To LR ' considering each data row in  Sample1.xls
    ' ( If column K of sample1.xls is greater than Column D of sample1.xls & Column H of sample1.xls is Greater than column K of sample1.xls ) or ( If column K of sample1.xls is lower than Column D of sample1.xls & Column H of sample1.xls is lower than column K of sample1.xls ) Then
    '                          Condition 1)                                    or        Condition 2)
        If (arrWs(Cnt, 11) > arrWs(Cnt, 4) And arrWs(Cnt, 8) > arrWs(Cnt, 11)) Or (arrWs(Cnt, 11) < arrWs(Cnt, 4) And arrWs(Cnt, 8) < arrWs(Cnt, 11)) Then
        Dim MtchRes As Variant ' for match column I of of Sample1.xls with second data column of text file  Sample2.csv  Clm2()
        Let MtchRes = Application.Match(CStr(arrWs(Cnt, 9)), Clm2(), 0) ' match column I of of 1.xls with second column data of text file of Alert..csv
        ' Match Column I of sample1.xls with second field values (column B) of sample2.csv
            If Not IsError(MtchRes) Then  ' if it is there then do nothing
            '  match obtsained do nothing
            Else '  it is not present  paste the column I data of sample1.xls to append second field values (column B) of sample2.csv
            Let TotalFileToRwCnt = TotalFileToRwCnt & "," & arrWs(Cnt, 9) & ",,,,,,,,,," & vbCr & vbLf ' make the single text string for the output text file
            End If

        Else
        ' Neither of the 2 conditions are met so do nothing
        End If
   
    Next Cnt

Rem 5 remake the text file
''5a) make a new text file string
'Dim strTotalFile As String
' Let strTotalFile = Join(arrRwsOut(), vbCr & vbLf)
'5b) make new file
Let FileNum = FreeFile(1)                                  ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
 Open ThisWorkbook.Path & "\" & "Sample2After.csv" For Output As #FileNum  ' CHANGE TO SUIT  ' Will be made if not there
 Print #FileNum, TotalFileToRwCnt '                      strTotalFile
 Close #FileNum
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFileToRwCnt)

Rem 6 Check File in Excel VBA open
' Workbooks.Open Filename:=ThisWorkbook.Path & "\" & "Sample2.csv"
' Workbooks.Open Filename:=ThisWorkbook.Path & Application.PathSeparator & "Sample2After.csv" ' CHANGE TO SUIT
'Dim Wb As Workbook
' Set Wb = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\sample2.csv")
End Sub

---

---

Share ‘sample2BEFORE.csv’ : https://app.box.com/s/d8lu7iatfv6h8spp9eru8asm3h4v4e4p
Share ‘Sample2After.csv’ : https://app.box.com/s/0j4118cwzzofe76ytb5rqkvz3qj0vseu
vba.xlsm : https://app.box.com/s/juekenyll42z84j6ms7qonzsngnugoyo
Sample1.xls : https://app.box.com/s/xh58fgjl74w06hvsd53jriqkohdm6a3q
macro.xlsm : https://app.box.com/s/z358r7tbc9hzthi539dlj49jsf4gyg8p
1.xls : https://app.box.com/s/38aoip5xi7018y9syt0xe4g04u95l6xk

Question 1

Solution for this question, ( 2020-05-28 22:13:09 Rajesh Kumar )
https://excel.tips.net/T002145_Dynam...Tab_Names.html

---

Question: ( Question 1 )
......I have a list of 80 students. I have made 80 sheets, 1 sheet for 1 student. I want to rename these 80 sheets on the basis of the name in the list, so that whenever I update the name list, the corresponding sheet-name changed automatically. I'm a beginner in this field. Please help me.

Solution.
Hello Rajesh
This requirement is fairly easy with VBA

There are 3 macros which I have written for you, and I am returning 2 workbook examples

Macro for your original requirement
Private Sub Worksheet_Change(ByVal Target As Range)
This macro is in both workbooks:
It does this: If you change any of your names in column B of the worksheets, then the name of the corresponding worksheet tab Name will change, as per your main original requirement.

Workbook AddNamesfromListToExistingWorksheets.xlsm
This is the workbook supplied by you. It has initially 80 student names in column B of the first worksheet. It has 80 additional worksheets , as made by you, with the names of 1 2 3 4 5 …. Etc.
This workbook has a macro , Sub ChangeNamesToExistingWorksheets() . This macro replaces those names with the names from the Student name list in column B

Workbook AddWorksheetsNamedFromList.xlsm
This is your original Workbook, with all but the first worksheet deleted. So this only contains one worksheet containing your list of student Names in column B
In this workbook, there is a macro, Sub AddWorksheetsfromListOfNames()
This macro adds worksheets with the student Names

---

Note: in your supplied data, you had two identical names at row 26 and at row 75, SACHIN KUMAR , so I changed it to SACHIN KUMAR 2 in row 75
( We could handle such cases in coding, automatically, later if you preferred )


Alan

---

Workbooks:
Share ‘AddNamesfromListToExistingWorksheets.xlsm’ : https://app.box.com/s/2ytj6qrsyaudh3tzgtodls8l05zn1woz
Share ‘AddWorksheetsNamedFromList.xlsm’ : https://app.box.com/s/yljwyk5ykxtjt2qhzvdpwcrft19phx54
For macros, see also post https://excelfox.com/forum/showthrea...ll=1#post13444

---

Cross posts
https://excel.tips.net/T002145_Dynamic_Worksheet_Tab_Names.html ( 2020-05-28 22:13:09 Rajesh Kumar ) https://excel.tips.net/T002145_Dynam...Tab_Names.html
https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/ https://www.mrexcel.com/board/thread...value.1135674/

Macros for this post ( Question 1 )
https://excelfox.com/forum/showthrea...ll=1#post13443

Code:

---

Option Explicit

'  https://excel.tips.net/T002145_Dynamic_Worksheet_Tab_Names.html  '    https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13443&viewfull=1#post13443    https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13443&viewfull=1#post13444

Sub RemoveAllButThisWorksheet()
Dim Cnt
    For Cnt = ThisWorkbook.Worksheets.Count To 2 Step -1 ' second worksheet counting tab from the left is worksheets item 2
    Let Application.DisplayAlerts = False
    ThisWorkbook.Worksheets.Item(Cnt).Delete
    Let Application.DisplayAlerts = True
    Next Cnt
End Sub
Sub ChangeNamesToExistingWorksheets() '
Rem 0
On Error GoTo Bed                      '      If we have problems then we want to make sure that we still  re enable  Events coding before ending the macro
 Let Application.EnableEvents = False  '      This will prevent anything we do in this macro from causing erratic working of any automatic event coding
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
 Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Name List")    '  first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
 Let Lr1 = Ws1.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. )
Dim arrNmes() As Variant              '      The  .Value2  property in the next line will return a field of values housed in Variant type Elements, so we need to  give the variant type to our array used to capture that  array  of values
 Let arrNmes() = Ws1.Range("B1:B" & Lr1 & "").Value2
Rem 2 Add and name worksheets from list
Dim Cnt As Long
    For Cnt = 2 To UBound(arrNmes(), 1) ' From (2,1) To (2,Lr1) in names array list column 2 ( column B )
    Let Worksheets.Item(Cnt).Name = arrNmes(Cnt, 1)
    Next Cnt
Bed:  ' error handling code section.
 Let Application.EnableEvents = True
End Sub

Sub AddWorksheetsfromListOfNames()
Rem 0
On Error GoTo Bed
 Let Application.EnableEvents = False
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
 Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Name List")    '  first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
 Let Lr1 = Ws1.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. )
Dim arrNmes() As Variant
 Let arrNmes() = Ws1.Range("B1:B" & Lr1 & "").Value2
Rem 2 Add and name worksheets from list
Dim Cnt As Long
    For Cnt = 2 To UBound(arrNmes(), 1) ' From (2,1) To (2,Lr1) in names array list column 2
    Worksheets.Add After:=Worksheets.Item(Worksheets.Count)
    Let ActiveSheet.Name = arrNmes(Cnt, 1)
    Next Cnt
   
Bed:
 Let Application.EnableEvents = True
End Sub
'
'

Private Sub Worksheet_Change(ByVal Target As Range)
    If IsArray(Target.Value) Then Exit Sub ' If we have changed more than 1 cell, our code lines below will error, so best do nothing in such a case
Dim Ws1 As Worksheet
 Set Ws1 = Me
Dim Lr1 As Long
 Let Lr1 = Ws1.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. )

Dim Rng As Range
 Set Rng = Ws1.Range("B2:B" & Lr1 & "")
    If Not Intersect(Rng, Target) Is Nothing Then ' The Excel VBA Application.Intersect method returns the range where all the given ranges cross, or  Nothing  if there are no common cells.  So, in this example,  we would have  Nothing  if our selection ( which VBA supplies in Target ) , did not cross our names list      '  https://docs.microsoft.com/en-us/office/vba/api/excel.application.intersect
    Dim Rw As Long
    Let Rw = Target.Row
    Let ThisWorkbook.Worksheets.Item(Rw).Name = Target.Value ' In the list, each row number corresponds to the item number of our worksheets made from that list
    Else
    ' changed cell was not in Student name list
    End If

End Sub


---

---

Cross posts
https://excel.tips.net/T002145_Dynamic_Worksheet_Tab_Names.html ( 2020-05-28 22:13:09 Rajesh Kumar ) https://excel.tips.net/T002145_Dynam...Tab_Names.html
https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/ https://www.mrexcel.com/board/thread...value.1135674/

Macro for these posts ( Question 2 )
https://excelfox.com/forum/showthrea...ll=1#post13442
https://excelfox.com/forum/showthrea...ll=1#post13448

Code:

---

'  _1. I want to create 5 tabs (Sheets) on the basis of these 5 names. (Now the workbook will have 6 tabs, including Master Sheet)  https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13445#post13445
Sub AddWorksheetsfromListOfNames2() '  https://excelfox.com/forum/showthread.php/2501-VBA-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-Value?p=13445#post13445    https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/
Rem 0
On Error GoTo Bed                      '      If we have problems then we want to make sure that we still  re enable  Events coding before ending the macro
 Let Application.EnableEvents = False  '      This will prevent anything we do in this macro from causing erratic working of any automatic event coding
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
 Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Master Sheet")    '  first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
 Let Lr1 = Ws1.Range("A" & 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. )
Dim arrNmes() As Variant
 Let arrNmes() = Ws1.Range("A1:A" & Lr1 & "").Value2
Rem 2 Add and name worksheets from list
Dim Cnt As Long
    For Cnt = 1 To UBound(arrNmes(), 1) ' From (2,1) To (2,Lr1) in names array list column 1 ( Column A )
    Worksheets.Add After:=Worksheets.Item(Worksheets.Count)
    Let ActiveSheet.Name = arrNmes(Cnt, 1)
    Next Cnt

Bed:
 Let Application.EnableEvents = True
End Sub  '      (Now the workbook will have 6 tabs, including Master Sheet)

Sub AddHypolinkToWorksheet()  '  https://www.mrexcel.com/board/threads/vba-for-dynamic-sheets-name-dynamic-link-hide-sheets-based-on-a-cell-value.1135674/
Rem 0
On Error GoTo Bed                      '      If we have problems then we want to make sure that we still  re enable  Events coding before ending the macro
 Let Application.EnableEvents = False  '      This will prevent anything we do in this macro from causing erratic working of any automatic event coding
Rem 1 worksheets 1 info
Dim Ws1 As Worksheet
 Set Ws1 = ThisWorkbook.Worksheets.Item(1) ' or Worksheets("Master Sheet")    '  first worksheet counting tab from the left is worksheets item 1
Dim Lr1 As Long
 Let Lr1 = Ws1.Range("A" & 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. )
Dim arrNmes() As Variant
 Let arrNmes() = Ws1.Range("A1:A" & Lr1 & "").Value2

Rem 2 Add hyperlinks
 Ws1.Hyperlinks.Delete
Dim Cnt
    For Cnt = 1 To Lr1        '  ='F:\Excel0202015Jan2016\OffenFragensForums\AllenWyatt\[DynamicWorksheetNamesLinkHideBasedOnCellValue.xlsm]RAHIM'!$A$1
    Dim Paf As String: Let Paf = "='" & ThisWorkbook.Path & "\[" & ThisWorkbook.Name & "]" & arrNmes(Cnt, 1) & "'!$A$1"
'    Ws1.Hyperlinks.Add Anchor:=Ws1.Range("A" & Cnt & ""), Address:="", SubAddress:="='" & arrNmes(Cnt, 1) & "'!A1", ScreenTip:=arrNmes(Cnt, 1), TextToDisplay:=arrNmes(Cnt, 1)
    Ws1.Hyperlinks.Add Anchor:=Ws1.Range("A" & Cnt & ""), Address:="", SubAddress:=Paf, ScreenTip:=arrNmes(Cnt, 1), TextToDisplay:=arrNmes(Cnt, 1)
    Next Cnt
Bed:  ' error handling code section.
 Let Application.EnableEvents = True
End Sub



Private Sub Worksheet_Change(ByVal Target As Range)
    If IsArray(Target.Value) Then Exit Sub ' If we have changed more than 1 cell, our code lines below will error, so best do nothing in such a case
Dim Ws1 As Worksheet
 Set Ws1 = Me
Dim Lr1 As Long
 Let Lr1 = Ws1.Range("A" & 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. )

Dim Rng As Range
 Set Rng = Ws1.Range("A1:A" & Lr1 & "")
    If Not Intersect(Rng, Target) Is Nothing Then ' The Excel VBA Application.Intersect method returns the range where all the given ranges cross, or  Nothing  if there are no common cells.  So, in this example,  we would have  Nothing  if our selection ( which VBA supplies in Target ) , did not cross our names list      '  https://docs.microsoft.com/en-us/office/vba/api/excel.application.intersect
    Dim Rw As Long
    Let Rw = Target.Row
        If Target.Value = "" Then '  5. If I delete the content of A1 (ANUJ), i.e, if cell A1 is blank, the corresponding sheet "ANUJ" should hide automatically.
        ThisWorkbook.Worksheets.Item(Rw + 1).Visible = False
        Exit Sub
        Else
        ThisWorkbook.Worksheets.Item(Rw + 1).Visible = True
        Let ThisWorkbook.Worksheets.Item(Rw + 1).Name = Target.Value ' In the list, each row number corresponds to one less than the item number of our worksheets made from that list
        End If
    Else
    ' changed cell was not in Student name list
    End If

'
Call AddHypolinkToWorksheet
End Sub

---

---

Share ‘DynamicWorksheetNamesLinkHideBasedOnCellValu e. : https://app.box.com/s/louq07ga6uth1508e572l7zr9fakont9