-
Code:
Option Explicit
Sub STEP7() '
Rem 1 Worksheets info
Dim Wbm As Workbook, Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
Set Wbm = Workbooks.Open(ThisWorkbook.Path & "\Merge.xlsx")
Set Ws1 = Wbm.Worksheets("Sheet1"): Set Ws2 = Wbm.Worksheets("Sheet2"): Set Ws3 = Wbm.Worksheets("Sheet3")
Rem 2 data Input
Dim arrS1() As Variant, arrS2() As Variant, arrS3() As Variant
Let arrS1() = Ws1.Range("A1").CurrentRegion.Value: arrS2() = Ws2.Range("A1").CurrentRegion.Value
'2b
ReDim arrS3(1 To UBound(arrS1(), 1)) ' A 1 dimension array of arrays
''2b(i)
' Let arrS3(1) = Ws3.Range("A" & Ws3.Range("A1").CurrentRegion.Columns.Count & "") ' header row as a one dimensional array
''2b(ii) data rows array output
Rem 3
Dim cnt
For cnt = 2 To UBound(arrS1(), 1) ' "row" count, cnt
'2b)(ii)
Dim Lc As Long: Let Lc = Ws3.Cells.Item(cnt, Ws3.Cells.Columns.Count).End(xlToLeft).Column ' last column in this row cnt
Let arrS3(cnt) = Ws3.Range("A" & cnt & ":" & CL(Lc + 1) & cnt & "").Value ' - returns an array of 1 "row" into this element of the array of arrays
Select Case arrS1(cnt, 9) ' column I
Case "SELL" 'If column I is sell
If arrS1(cnt, 11) > arrS2(cnt, 5) Then ' if column K is Greater than sheet2 of column E then
Ws3.Range("B" & cnt & ":" & CL(Lc) & cnt & "").Cells.ClearContents
Else
Let arrS3(cnt)(1, UBound(arrS3(cnt), 2)) = UBound(arrS3(cnt), 2) - 1 ' Put in a value in last array "column"
End If
Case "BUY" 'If column I is buy
If arrS1(cnt, 11) < arrS2(cnt, 6) Then ' if column K is lower than sheet2 of column F then
Ws3.Range("B" & cnt & ":" & CL(Lc) & cnt & "").Cells.ClearContents
Else
Let arrS3(cnt)(1, UBound(arrS3(cnt), 2)) = UBound(arrS3(cnt), 2) - 1 ' Put in a value in last array "column"
End If
End Select
'3b) output "row"
Let Ws3.Range("A" & cnt & "").Resize(1, Lc + 1).Value = arrS3(cnt)
Next cnt
Rem 4 ....and after putting the remark clear sheet 1 and sheet 2
Ws1.Cells.ClearContents
Ws2.Cells.ClearContents
Wbm.Save
Wbm.Close
End Sub
'If column I is sell
'then see the value of column K &
'if column K is Greater than sheet2 of column E then put the remark in sheet3 in the stock name from column B
'If column I is buy
'see the value of column K &
'if column K is lower than sheet2 of column F then put the remark in sheet3 in the stock name from column B
'remark will be in series like 1,2,3,4,5,6 and so on
'vba is palced in a separate file
'all files are located in same place
'and after putting the remark clear sheet 1 and sheet 2
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
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg. 9h6VhNCM-DZ9h7EqbG23kg
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwGTEyefOX7msIh1wZ4AaABAg. 9h4sd6Vs4qE9h7KvJXmK8o
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=Ugw3nF0C04AGt73H1BB4AaABAg. 9h6VhNCM-DZ9h7E1gwg4Aq
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgywFtBEpkHDuK55r214AaABAg
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg. 9h5lFRmix1R9h79hNGvJbu
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg. 9h5lFRmix1R9h79YAfa24T
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg. 9h5lFRmix1R9h79M1SYH1E
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg. 9h5lFRmix1R9h78SxhXTnR
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgwviLabd7r_3KpP6wh4AaABAg. 9h5lFRmix1R9h78GftO_iE
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h77HSGDH4A
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h76fafzcEJ
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h759YIjlaG
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg. 9h740K6COOA9h74pjGcbEq
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgyG714V_k7odQMrTz14AaABAg
https://www.youtube.com/watch?v=2oT4qrHmDMY&lc=UgzJJUDVv2Mb6YGkPYh4AaABAg. 9h5uPRbWIZl9h7165DZdjg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
-
The data is being cleared, But it is being put back in!
To explain:-
These two code lines clear the range when the condition is not met
Ws3.Range("B" & cnt & ":" & CL(Lc) & cnt & "").ClearContents
Ws3.Range("B" & cnt & ":" & CL(Lc) & cnt & "").ClearContents
This next code line puts all the data in. It does this after the Select Case / End Select
Let Ws3.Range("A" & cnt & "").Resize(1, Lc + 1).Value = arrS3(cnt)
Because it does this after the Select Case / End Select, the code line will be done both when the condition is met and when the condition is not met.
So , the range is being cleared if the condition is not met. But it is then being re filled.
The ranges are filled from the array, arrS3(Cnt)
There are two possibilities to overcome this problem.
_1 empty the array , ( instead of clearing the range )
Code:
Dim Cnt As Long, Clms As Long
For Cnt = 2 To UBound(arrS1(), 1) ' "row" count, cnt
'2b)(ii)
Dim Lc As Long: Let Lc = Ws3.Cells.Item(Cnt, Ws3.Cells.Columns.Count).End(xlToLeft).Column ' last column in this row cnt
Let arrS3(Cnt) = Ws3.Range("A" & Cnt & ":" & CL(Lc + 1) & Cnt & "").Value ' - returns an array of 1 "row" into this element of the array of arrays
Select Case arrS1(Cnt, 9) ' column I
Case "SELL" 'If column I is SELL
If arrS1(Cnt, 11) > arrS2(Cnt, 5) Then ' if column K is Greater than column E of sheet2 Then
' Condition not met ... clear the data from cloumn B till the end of the data in that entire row
' Ws3.Range("B" & Cnt & ":" & CL(Lc) & Cnt & "").ClearContents
For Clms = 2 To Lc
Let arrS3(Cnt)(1, Clms) = ""
Next Clms
Else
' Condition is met
Let arrS3(Cnt)(1, UBound(arrS3(Cnt), 2)) = UBound(arrS3(Cnt), 2) - 1 ' Put in a value in last array "column"
End If
Case "BUY" 'If column I is BUY
If arrS1(Cnt, 11) < arrS2(Cnt, 6) Then ' if column K is lower than column F of sheet2 Then
' Condition is not met ....clear the data from cloumn B till the end of the data in that entire row
' Ws3.Range("B" & Cnt & ":" & CL(Lc) & Cnt & "").ClearContents
For Clms = 2 To Lc
Let arrS3(Cnt)(1, Clms) = ""
Next Clms
Else
' Condition is met
Let arrS3(Cnt)(1, UBound(arrS3(Cnt), 2)) = UBound(arrS3(Cnt), 2) - 1 ' Put in a value in last array "column"
End If
End Select
' '3b) output "row"
Let Ws3.Range("A" & Cnt & "").Resize(1, Lc + 1).Value = arrS3(Cnt)
Next Cnt
OR:-
_ 2 Use the code line which puts in all the data for the met condition within the Select Case / End Select
Code:
Rem 3
Dim Cnt As Long
For Cnt = 2 To UBound(arrS1(), 1) ' "row" count, cnt
'2b)(ii)
Dim Lc As Long: Let Lc = Ws3.Cells.Item(Cnt, Ws3.Cells.Columns.Count).End(xlToLeft).Column ' last column in this row cnt
Let arrS3(Cnt) = Ws3.Range("A" & Cnt & ":" & CL(Lc + 1) & Cnt & "").Value ' - returns an array of 1 "row" into this element of the array of arrays
Select Case arrS1(Cnt, 9) ' column I
Case "SELL" 'If column I is SELL
If arrS1(Cnt, 11) > arrS2(Cnt, 5) Then ' if column K is Greater than column E of sheet2 Then
' Condition not met ... clear the data from cloumn B till the end of the data in that entire row
Ws3.Range("B" & Cnt & ":" & CL(Lc) & Cnt & "").ClearContents
Else
' Condition is met
Let arrS3(Cnt)(1, UBound(arrS3(Cnt), 2)) = UBound(arrS3(Cnt), 2) - 1 ' Put in a value in last array "column"
Let Ws3.Range("A" & Cnt & "").Resize(1, Lc + 1).Value = arrS3(Cnt)
End If
Case "BUY" 'If column I is BUY
If arrS1(Cnt, 11) < arrS2(Cnt, 6) Then ' if column K is lower than column F of sheet2 Then
' Condition is not met ....clear the data from cloumn B till the end of the data in that entire row
Ws3.Range("B" & Cnt & ":" & CL(Lc) & Cnt & "").ClearContents
Else
' Condition is met
Let arrS3(Cnt)(1, UBound(arrS3(Cnt), 2)) = UBound(arrS3(Cnt), 2) - 1 ' Put in a value in last array "column"
Let Ws3.Range("A" & Cnt & "").Resize(1, Lc + 1).Value = arrS3(Cnt)
End If
End Select
'' '3b) output "row"
' Let Ws3.Range("A" & Cnt & "").Resize(1, Lc + 1).Value = arrS3(Cnt)
Next Cnt
-
Thnx Alot Doc Sir and Molly Sir
Thnx for ur Great Support sir
-
You are welcome.
( Molly is a Lady ( Woman ) - She is not a Sir, She is a Ma'am or Madam )
Thank you Molly, Ma'am
Sir - Man
Ma'am - Woman
-
Thnx Doc Sir & Molly Mam For the Great Help
-
Glad you got the answer eventually
-
2 Attachment(s)
copy paste conditional
If column B of 2.xlsm match with column B of 1.xls then paste the data from column C of 2.xls as 1,2,3,4,5 and so on....
&
If column B of 2.xlsm doesn't match with column B of 1.xls then delete all the data from column C of that row
macro will be placed in 2.xlsm
all files re located in different path
sheet name can be anything
plz see the sample file
-
1 Attachment(s)
Hello Vixer.
This is similar to what I did for you before, I think.
Here I have some new explanations for you Here
http://www.excelfox.com/forum/showth...ll=1#post13165
http://www.excelfox.com/forum/showth...ll=1#post13164
Before:
_____ Workbook: 1.xlsx ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
|---|
1 |
NSE |
25 |
6 |
> |
50000 |
A |
|
2 |
NSE |
22 |
6 |
> |
10000 |
A |
|
3 |
NSE |
15083 |
6 |
> |
70000 |
A |
|
4 |
NSE |
17388 |
6 |
> |
20000 |
A |
|
5 |
NSE |
100 |
6 |
> |
170000 |
A |
|
6 |
|
|
|
|
|
|
|
_____ Workbook: 2.xlsm ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
|---|
1 |
Symbol |
|
|
|
|
|
|
|
2 |
ACC |
22 |
1 |
2 |
|
|
|
|
3 |
ADANIENT |
25 |
1 |
|
|
|
|
|
4 |
ADANIPORTS |
15083 |
1 |
2 |
3 |
|
|
|
5 |
ADANIPOWER |
17388 |
1 |
2 |
3 |
4 |
5 |
|
6 |
AMARAJABAT |
100 |
1 |
2 |
3 |
4 |
|
|
7 |
ASIANPAINT |
236 |
1 |
2 |
|
|
|
|
8 |
|
|
|
|
|
|
|
|
now, run macro from here:
http://www.excelfox.com/forum/showth...ll=1#post13166
After results
_____ Workbook: 2.xlsm ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
|---|
1 |
Symbol |
|
|
|
|
|
|
|
2 |
ACC |
22 |
1 |
2 |
3 |
|
|
|
3 |
ADANIENT |
25 |
1 |
2 |
|
|
|
|
4 |
ADANIPORTS |
15083 |
1 |
2 |
3 |
4 |
|
|
5 |
ADANIPOWER |
17388 |
1 |
2 |
3 |
4 |
5 |
6 |
6 |
AMARAJABAT |
100 |
1 |
2 |
3 |
4 |
5 |
|
7 |
ASIANPAINT |
236 |
|
|
|
|
|
|
8 |
|
|
|
|
|
|
|
|
Molly
-
Yes Molly Mam Actually it requires the modification to increase the output
Sorry for the same Mam But in future there will not be any question similar to this
-
No need to apologise, I was just making a passing remark, that’s all
It was easy for me to do , because of the simularities to the previous Thread, that's all
:) .
