Results 1 to 10 of 31

Thread: Test

Threaded View

Previous Post Previous Post   Next Post Next Post
  1. #5
    _...........from last post

    Try this data:


    _____ Workbook: Merge2.xls ( Using Excel 2007 32 bit )
    Row\Col
    A
    B
    C
    D
    E
    F
    G
    H
    I
    J
    K
    L
    1
    Exchange Symbol Series/Expiry Open High Low Prev Close LTP
    2
    NSE ACC EQ
    10
    11
    12
    13
    8
    SELL
    11.247
    1234
    3
    NSE ADANIENT EQ
    8
    7
    6
    5
    4
    BUY
    1.334
    125
    4
    Worksheet: Sheet1





    Code:
    Option Explicit
    Sub HidnInLisWb() '
    Rem 1 Worksheets info
    Dim Wbm As Workbook, Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
     Set Wbm = Workbooks("Merge2.xls")
     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.Clear
     Ws2.cells.Clear
    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
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    https://eileenslounge.com/viewtopic.php?p=317218#p317218
    https://eileenslounge.com/viewtopic.php?p=316955#p316955
    https://eileenslounge.com/viewtopic.php?p=316955#p316955
    https://eileenslounge.com/viewtopic.php?p=316940#p316940
    https://eileenslounge.com/viewtopic.php?p=316927#p316927
    https://eileenslounge.com/viewtopic.php?p=317014#p317014
    https://eileenslounge.com/viewtopic.php?p=317006#p317006
    https://eileenslounge.com/viewtopic.php?p=316935#p316935
    https://eileenslounge.com/viewtopic.php?p=316875#p316875
    https://eileenslounge.com/viewtopic.php?p=316254#p316254
    https://eileenslounge.com/viewtopic.php?p=316280#p316280
    https://eileenslounge.com/viewtopic.php?p=315915#p315915
    https://eileenslounge.com/viewtopic.php?p=315512#p315512
    https://eileenslounge.com/viewtopic.php?p=315744#p315744
    https://www.eileenslounge.com/viewtopic.php?p=315512#p315512
    https://eileenslounge.com/viewtopic.php?p=315680#p315680
    https://eileenslounge.com/viewtopic.php?p=315743#p315743
    https://www.eileenslounge.com/viewtopic.php?p=315326#p315326
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40752
    https://eileenslounge.com/viewtopic.php?p=314950#p314950
    https://www.eileenslounge.com/viewtopic.php?p=314940#p314940
    https://www.eileenslounge.com/viewtopic.php?p=314926#p314926
    https://www.eileenslounge.com/viewtopic.php?p=314920#p314920
    https://www.eileenslounge.com/viewtopic.php?f=30&t=40533&p=314837#p314837
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 05-20-2024 at 03:48 PM.

Similar Threads

  1. Test
    By DocAElstein in forum Test Area
    Replies: 0
    Last Post: 03-30-2020, 07:20 PM
  2. test
    By EFmanagement in forum Test Area
    Replies: 0
    Last Post: 09-29-2019, 11:01 PM
  3. This is a test Test Let it be
    By Admin in forum Test Area
    Replies: 6
    Last Post: 05-30-2014, 09:44 AM
  4. Test
    By Excel Fox in forum Word Help
    Replies: 0
    Last Post: 07-05-2011, 01:51 AM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •