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




Reply With Quote

Bookmarks