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

**fixer** · 03-17-2020, 09:56 PM

This post is a … Moderator Post Copy…. ( link to post is https://excelfox.com/forum/showthread.php/2433-vba-Copy-Paste-Conditional-to-put-remark-1-2-3-etc#post12828 or https://tinyurl.com/y3c7lvlh
https://excelfox.com/forum/showthrea...-etc#post12828

Currently the OP, ( possible real name most of the time , Avinash Singh from Mumbai India ), appears to have many of his own accounts ( hundreds by his own admission to me privately ) . In addition he has temporary access to many other peoples accounts.
It appears that his current “job” is to paste a question into a forum, and pass any macro given on to the person assigning him the task old posting the question.
He will often duplicate cross post a question.
Quite often the question is wrong and the macros and files do not match up or are full of mistakes )
( He may have his own career plans in parallel to this current job. That is likely also to be responsible for some of his many duplicate cross postings of similar questions )
He has a very poor understanding of the English language, and has never been anywhere near Excel or Microsoft Office. If the assigning person is not happy with any returned macro, then he may use some of his many canned replies or even attempt some reply himself in the hope of it generating another macro, which he passes on to the person assigning him the job of posting the question…
He barely understand , if at all, anything he posts himself in a question of the replies he makes himself
_.... If the assigning person is not happy with any returned macro, then he may use some of his many canned replies or even attempt some reply himself in the hope of it generating another macro, which he passes on to the person assigning him the job of posting the question…
He barely understand , if at all, anything he posts himself in a question of the replies he makes himself
_..... If the assigning person is not happy with any returned macro, then he may use some of his many canned replies or even attempt some reply himself in the hope of it generating another macro, which he passes on to the person assigning him the job of posting the question…
He barely understand , if at all, anything he posts himself in a question of the replies he makes himself
_.... If the assigning person is not happy with any returned macro, then he may use some of his many canned replies or even attempt some reply himself in the hope of it generating another macro, which he passes on to the person assigning him the job of posting the question…
He barely understand , if at all, anything he posts himself in a question of the replies he makes himself

_... and so on, and so on…

The questions are often variations on a similar one. In the next copy of the first Thread post, I am attempting to collect / merge / reference postings of those which can approximately be given the title of …

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

**Molly Brennholz** · 03-20-2020, 03:53 PM

Hello

Your data ?????

SELL is K=1100.947 , sheet 2 column E is 1102 … so K is NOT > column E ---- so no output – no remark
BUY is K = 130.734 , sheet 2 column E is 129 … so K is NOT < column E ----- so no output – no remark

See here: http://www.excelfox.com/forum/showth...ll=1#post12837

So Try this data : http://www.excelfox.com/forum/showth...ll=1#post12838

( You also need Function CL( ) )

To explain the solution to you:
If your data is
_____ Workbook: Merge2.xls ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D
1	Symbol
2	ACC	1	2	3
3	ADANIENT	1
4

Worksheet: Sheet3

arrS3() =

arrS3(1)

arrS3(2)

arrS3(3)

arrS3(1) =

Symbol

arrS3(2)=

ACC

1

2

3

arrS3(3)=

ADANIENT

1

Let arrS3(cnt)(1, UBound(arrS3(cnt), 2)) =

File here: http://www.excelfox.com/forum/showth...ll=1#post12840
(You also need Function CL( ) )

Molly

**fixer** · 03-20-2020, 06:04 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
         Let arrS3(cnt)(1, UBound(arrS3(cnt), 2)) = UBound(arrS3(cnt), 2) - 1 ' Put in a value in last array "column"
        Else
        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
        Let arrS3(cnt)(1, UBound(arrS3(cnt), 2)) = UBound(arrS3(cnt), 2) - 1 ' Put in a value in last array "column"
       Else
       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
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
'     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

I used this code i have not found any error while raning the code sir but this code is not pasting the result sir plz relook sir

**Molly Brennholz** · 03-20-2020, 06:45 PM

Originally Posted by Molly Brennholz

Hello

Your data ?????

SELL is K=1100.947 , sheet 2 column E is 1102 … so K is NOT > column E ---- so no output – no remark
BUY is K = 130.734 , sheet 2 column E is 129 … so K is NOT < column E ----- so no output – no remark

See here: http://www.excelfox.com/forum/showth...ll=1#post12837 ....

Originally Posted by fixer

...I used this code i have not found any error while raning the code sir but this code is not pasting the result ..

Correct. This is as expected. This is what you asked for
no output – no remark = code is not pasting the result = There is no result to paste.

Correct.

Check your data. Check your logic. Explain again what should happen.
Maybe you gave wrong data. Maybe you gave wrong logic.
maybe you asked wromng question.
Or i do not understand what you want.
Try to explain again with more examples

**fixer** · 03-20-2020, 08:47 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
         
        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
        
       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

Thnx for the hint sir actually u misunderstood the condition i corrected the same sir
but one issue is there
i ran the code and i send the screenshot of that result plz see the attachment (result.png )
and again i will ran the code and what i need if again the condition met then i need result but it will be in column C and if i again ran the code then it will be in column D
and the number will be in series in column B it will be 1 and if it is column C then 2 and if column D then 3 and so on

**Molly Brennholz** · 03-20-2020, 09:05 PM

Sorry, I am having difficulty to understand you.
I do not understand what you are saying.

Upload a file and try again to explain.

**DocAElstein** · 03-20-2020, 09:17 PM

Problem is possibly your understanding of English language.

__ < is less than
__ > is greater than

If arrS1(cnt, 11) > arrS2(cnt, 5) Then ----- If column K is Greater than column E Then
If arrS1(cnt, 11) < arrS2(cnt, 5) Then ----- If column K is less than column E Then

3 is greater than 2
2 is less than 3
3 is > 2
2 is < 3

3 > 2 is True
3 > 5 is False
2 < 1 is False
3 > 5 is False

Code:

      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
        ' if column K is Greater than sheet2 of column E then do nothing
        Else
        ' if column K is less than or = to sheet2 of column E then
        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
       ' if column K is lower than sheet2 of column E then do nothing
       Else
       '  if column K is greater than or = to sheet2 of column E then
       Let arrS3(Cnt)(1, UBound(arrS3(Cnt), 2)) = UBound(arrS3(Cnt), 2) - 1 ' Put in a value in last array "column"
       End If

Molly did understand correct!!

Vixer, You did explain it wrong!!

Molly, you did it correct. Vixer explained it wrong. ( He has difficulty with English language

)

This is wrong:

Originally Posted by fixer

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

This is correct:
If column I is sell then see the value of column K & if column K is less than sheet2 of column E then put the remark in sheet3 in the stock name from column B

**fixer** · 03-21-2020, 12:38 AM

Plz see the sample file doc sir

**DocAElstein** · 03-21-2020, 01:55 AM

Hi

What is the problem??

You want this…Suppose column B already has data
and after that I am runing the macro
then the result will be pasted to column C
and the result which we have to paste is 2
and again when I ran the macro then column C can have the data or it cant have
but if column C has data then the result should be paste as 3 and so on….

Have you tried Molly’s macro ??

I have tried Molly’s macro . ( your version here: http://www.excelfox.com/forum/showth...ll=1#post12846 ) it does this:

Start like this
_____ Workbook: Merge (1).xlsx ( Using Excel 2007 32 bit )

_Row\^Col	A	B	C	D	E
1	Symbol
2	ACC
3	ADANIENT
4

Worksheet: Sheet3

Now Run it once … It does this

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

_Row\^Col	A	B
1	Symbol
2	ACC	1
3	ADANIENT	1
4

Worksheet: Sheet3

Now run it again… It does this

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

_Row\^Col	A	B	C
1	Symbol
2	ACC	1	2
3	ADANIENT	1	2
4

Worksheet: Sheet3

Now run it again… It does this..

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

_Row\^Col	A	B	C	D
1	Symbol
2	ACC	1	2	3
3	ADANIENT	1	2	3
4

Worksheet: Sheet3

and so on.............................

So it does exactly what you asked for

What is your problem ???

The macro from Molly is doing exactly what you are asking for !!!!

Code:

Sub STEP7_() '
Rem 1 Worksheets info
Dim Wbm As Workbook, Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
 Set Wbm = Workbooks("Merge (1).xlsx")
' Set Wbm = Workbooks.Open(ThisWorkbook.Path & "\Merge1.xlsx")  '   "\Merge.xlsx") '  change to suit
 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
        ' do nothing
        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
       ' do nothing
       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


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