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
Reply With Quote
Originally Posted by Molly Brennholz
)
Bookmarks