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

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

**Molly Brennholz** · 03-21-2020, 02:28 AM

Thanks, Alam, for the confirmation
Molly
x

**fixer** · 03-21-2020, 05:51 AM

Sorry Doc Sir the code is perfect no doubt and thnx molly Sir and Doc Sir for the Great Help

**fixer** · 03-21-2020, 06:16 AM

one more condition i have to add doc sir
if condition met then it will paste the result but if condition doesnt met then see the sample pic
let us assume again i am runing the code and acc mets the condition then C2 gets the result as 2
& adanient doesnt met the condition then it should clear the data from cloumn B till the end of the data in that entire row
means the adanient will be there in that row & in that row there will not be any data sir so plz doc sir have a relook sir

**DocAElstein** · 03-21-2020, 02:08 PM

Hello

You may possibly have uploaded the wrong sample pic?
The sample pic does not explain anything…

I think you are having difficulty yourself understanding what you want. I do not think you understand anything about what is going on.
Or
You are almost completely unable to explain anything correctly in English.

This is what Molly’s macro does :-

The conditions which are met are in current macro ( http://www.excelfox.com/forum/showth...ll=1#post12850 ) are these… …

For each row – the two condition is met scenarios….

If column I is SELL then see the value of column K & if column K is less than or equal to column E in sheet 2 then put the remark in sheet3

If column I is BUY then see the value of column K & if column K is greater than or equal t column F in sheet 2 then put the remark in sheet3

The remark will be in series like 1,2,3,4,5,6 …… and so on. So the remark in column B will always be 1. The remark in column C will always be 2 … and so on

Currently, if the condition is not met then ‘ Nothing is done

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
        ' do nothing - Nothing is done - column K is Greater than column E of sheet2
        Else

Code:

      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 -  Nothing is done - column K is lower than  column F of sheet2
       Else

We can only make guesses at what you might want…
‘ Condition not met ... clear the data from column B till the end of the data in that entire row

Code:

     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 column B till the end of the data in that entire row
         Ws3.Range("B" & cnt & ":B" & CL(Lc) & "").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"
        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 column B till the end of the data in that entire row
        Ws3.Range("B" & cnt & ":B" & CL(Lc) & "").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"
       End If
     End Select
' Edit: see corrrection post #16 below : http://www.excelfox.com/forum/showth...ll=1#post12858

The biggest problem remains that you cannot explain anything correctly in English. The biggest problem is not Excel or Excel VBA. The biggest problem is the communication difficulty between us

Have you tried this ?
https://translate.google.de/?hl=de#v...te&sl=mr&tl=en
https://translate.google.de/?hl=de#v...%20language%3F

Alan

**DocAElstein** · 03-21-2020, 02:50 PM

Please try to understand this:

Copy all three macros to the same code module

Only Run macro Sub CallIfElse()

Code:

Sub CallIfElse()
 Call IfElse1(2)
 Call IfElse1(3)
 Call IfElse1(4)

 Call IfElse2(2)
 Call IfElse2(3)
 Call IfElse2(4)
End Sub
Sub IfElse1(ByVal A_Number As Long)
    If A_Number > 3 Then ' If a number is greater Than 3 then
    ' condition (A_Number > 3 ) is met
    ' condition (A_Number < 3 or A_Number  = 3 ) is not met
     MsgBox prompt:="Your number is " & A_Number & "   It is greater than 3"
    Else
    ' condition (A_Number > 3 ) is not met
    ' condition (A_Number < 3 or A_Number = 3 ) is  met
     MsgBox prompt:="Your number is " & A_Number & "   It is less than or it is equal to 3"
    End If
End Sub
Sub IfElse2(ByVal A_Number As Long)
    If A_Number < 3 Then ' If a number is less Than 3 then
    ' condition (A_Number < 3) is met
    ' condition (A_Number > 3 or A_Number  = 3) is not met
     MsgBox prompt:="Your number is " & A_Number & "   It is less than 3"
    Else
    ' condition (A_Number < 3) is not met
    ' condition (A_Number > 3 or  A_Number  = 3) is met
     MsgBox prompt:="Your number is " & A_Number & "   It is greater than or it is equal to 3"
    End If
End Sub

**fixer** · 03-21-2020, 03:27 PM

Doc Sir the code is doing perfect things
only this line creating error
Ws3.Range("B" & cnt & ":B" & CL(Lc) & "").ClearContents

rest everyhing is 101% perfect Doc sir

**DocAElstein** · 03-21-2020, 03:39 PM

my mistake....it should be ...

Code:

Ws3.Range("B" & cnt & ":" & CL(Lc) & cnt & "").ClearContents

Cnt is row number , like 2 or 3
Lc is last column number , like 2 or 3 or 4 or 5 .... and so on
CL(Lc) is last column Letter like B or C or D or E ..... and so on

So
__ "B" & cnt & ":" & CL(Lc) & cnt & "" __
is like
__ “B2:D2”
or
__ “B2:F2”
or
__ “B3:G3”
.. and so on

**fixer** · 03-21-2020, 07:36 PM

Code:

Ws3.Range("B" & cnt & ":" & CL(Lc) & cnt & "").ClearContents

I putted this code i am not getting any error but it is not clearing the data
i tried this also

Code:

Ws3.Range("B" & cnt & ":" & CL(Lc) & cnt & "").cells.ClearContents

but this is also not clearing the data Doc Sir plz relook sir

**DocAElstein** · 03-21-2020, 08:03 PM

Post the macro that you are using

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

Thread Tools

Search Thread

Display

Similar Threads

VBA Dir File Copy and Paste: Check if file exists then copy file from one directory to another. Bat File

VBA -- Copy/Paste across sheets

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions