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

Printable View

Show 40 post(s) from this thread on one page

03-21-2020, 01:55 AM
DocAElstein

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

C

D

E

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

D

E

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

E

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
03-21-2020, 02:28 AM
Molly Brennholz

Thanks, Alam, for the confirmation
Molly
x
03-21-2020, 05:51 AM
fixer

Sorry Doc Sir the code is perfect no doubt and thnx molly Sir and Doc Sir for the Great Help
03-21-2020, 06:16 AM
fixer

1 Attachment(s)

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
03-21-2020, 02:08 PM
DocAElstein

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
03-21-2020, 02:50 PM
DocAElstein

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
03-21-2020, 03:27 PM
fixer

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
03-21-2020, 03:39 PM
DocAElstein

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
03-21-2020, 07:36 PM
fixer

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
03-21-2020, 08:03 PM
DocAElstein

Post the macro that you are using

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

Show 40 post(s) from this thread on one page