vba Copy Paste Conditional to put remark 1 2 3 .. etc

**fixer** · 03-21-2020, 10:15 PM

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

**DocAElstein** · 03-21-2020, 10:30 PM

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

**fixer** · 03-22-2020, 01:18 AM

Thnx Alot Doc Sir and Molly Sir
Thnx for ur Great Support sir

**DocAElstein** · 03-22-2020, 02:05 AM

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

**fixer** · 03-22-2020, 09:46 PM

Thnx Doc Sir & Molly Mam For the Great Help

**Molly Brennholz** · 03-22-2020, 10:19 PM

Glad you got the answer eventually

**fixer** · 04-29-2020, 12:03 AM

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

**Molly Brennholz** · 04-29-2020, 04:37 PM

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
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

Worksheet: Sheet1 (4)

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

_Row\^Col	A	B	C	D	E	F	G
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

Worksheet: Sheet1

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

Worksheet: Sheet1

Molly

**fixer** · 04-29-2020, 05:20 PM

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

**Molly Brennholz** · 04-29-2020, 06:48 PM

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

.