Simple Excel VBAF

In Both cases IF & Else it copies data from Data WB to Process WB .

Date in Data WB is  Newest to oldest so if we copy & past to Process WB it will remain same way but for Sub FindValues() it required Date in Oldest to newest. so sort date which is in column A oldest to newest.

Copy L3:W end row except last row & past to related sheet.
But after shift row down data which is exist in sheet from A3.

Basically I am finding high & low points from data of Open high low Close of stock price. so to find this high Low point (Zigzag points at least one High or low point required in range L3:N3,you can say it start point). Formula & code is set in that manner after that it will find next high low point & its date of occurrence. so if data WB & Result WB have same name sheet then that name operation is done in past, so we need last point for that name from result WB & pasted to Process for find further points. After process we have more points including the point which we copied from result WB so in copy past task need to exclude that as it is already in result WB. But in case of Data WB & Result WB name not match then we have to put manually that L3:N3 point as there is not any past exploration.


Please 1st understand then write Code else it will leads to trial & error. need further clarification pls let me know.

Thanks

How about sample files with data resembling the real data. It's a total waste of my time to try to figure out exactly what you want with the data I have!

I give you full description with screen shots just tell me which part you dint understand?

let first explain what mi achieving by this. I want High  Low point of stock price. for that I have Code Sub FindValue().which do calculation & & find high low points from data provided. There is two types of data require for this exploration. historical data (Column A:F) & last point (L3:N3).

so 1st kind of data we can get it from Data WB (A:F) but 2nd type of data we can get two ways. A) if in past we done this exploration then we can copy last points from result WB (A3:C3) 2) but if we add new sheet in data WB then there is not match found in Result WB & we have to put manually 2nd type of data via input message box.

Note :- In Data WB data will be added every day for each sheet name.

Thanks

Sub Demo()

    Dim wbCurrent, wbData, wbResult As Workbook
    Dim ws, w As Worksheet
    Dim varData() As String
    Dim arrSheetName() As String
    Dim i As Integer
    Dim blnExists As Boolean

    Set wbCurrent = ActiveWorkbook
    Set wbData = Workbooks.Open(ActiveWorkbook.Path & "\Data.xlsx")    '("H:\4.Trading Master\Thunderbolt\Simple Excel Formula\Data.xlsx")

    wbData.Activate
    SortWorksheets

    Set wbResult = Workbooks.Open(ActiveWorkbook.Path & "\Result.xlsx")    '("H:\4.Trading Master\Thunderbolt\Simple Excel Formula\Result.xlsx")

    wbResult.Activate
    SortWorksheets

    For Each ws In wbData.Worksheets
        If ws.Index > wbData.Sheets("Start").Index And ws.Index < wbData.Sheets("Finish").Index Then
            If (wbResult.Sheets(ws.Index).Name <> ws.Name) Or (ws.Index > Sheets(Sheets.Count).Index - 1) Then
                For Each w In wbResult.Worksheets
                    If w.Name = ws.Name Then blnExists = True
                Next
                If Not blnExists Then
                    wbResult.Sheets.Add.Name = ws.Name
                    i = i + 1
                    ReDim Preserve arrSheetName(0 To i)
                    arrSheetName(i) = ws.Name
                End If
            End If
        End If
    Next

    wbData.Activate

    If wbData.Sheets(1).Name = wbResult.Sheets(1).Name Then
        wbData.Sheets(1).Range("A1:F" & Range("F1048576").End(xlUp).Row).Copy
        wbCurrent.Activate
        Range("A1").PasteSpecial
        SortData
        
        wbResult.Activate
        wbResult.Sheets(1).Range("A3:C3").Copy
        wbCurrent.Activate
        Range("L3:N3").PasteSpecial
        FindValues
        .Range("N3:W" & Range("W1048576").End(xlUp).Row).Offset(-1, 0).Copy
        wbResult.Activate
        wbResult.Sheets(1).Range("A3").Insert Shift:=xlDown
        
        wbCurrent.Activate
        .Range("L3:N3").ClearContents
        .Range("A1:F" & Range("F1048576").End(xlUp).Row).ClearContents
        .Range("N3:W" & Range("F1048576").End(xlUp).Row).ClearContents

Select allOpen in new window

I had added some line via online searching for IF Match found statement but it flashes errorI had added this Sub for Sorting

Sub SortData()

 Dim oneRange As Range
 Dim aCell As Range
 Set oneRange = Range("A3:F" & Range("F1048576").End(xlUp).Row)
 Set aCell = Range("A3")
 oneRange.Sort Key1:=aCell, Order1:=xlAscending, Header:=xlNo

 End Sub

Select allOpen in new window

Thanks
Process.xlsm

remove the period before range

Period...?

change
.Range("N3:W" & Range("W1048576").End(xlUp).Row).Offset(-1, 0).Copy
to
Range("N3:W" & Range("W1048576").End(xlUp).Row).Offset(-1, 0).Copy

Working - No error
But In data WB & Result WB I had make both sheet remain same between sheet Start - finish i.e. there is only 2 sheets in both WB with same name so no need to go for ELSE Code part to run..... only Match part to run but it is not working ...? any idea ? I had run through code step by step (F8) but it not executing IF Match found lines ....where mi wrong.?

This is the whole code

Option Explicit

Sub Demo()

    Dim wbCurrent, wbData, wbResult As Workbook
    Dim ws, w As Worksheet
    Dim varData() As String
    Dim arrSheetName() As String
    Dim i As Integer
    Dim blnExists As Boolean

    Set wbCurrent = ActiveWorkbook
    Set wbData = Workbooks.Open(ActiveWorkbook.Path & "\Data.xlsm")    '("H:\4.Trading Master\Thunderbolt\Simple Excel Formula\Data.xlsx")

    wbData.Activate
    SortWorksheets

    Set wbResult = Workbooks.Open(ActiveWorkbook.Path & "\Result.xlsm")    '("H:\4.Trading Master\Thunderbolt\Simple Excel Formula\Result.xlsx")

    wbResult.Activate
    SortWorksheets

    For Each ws In wbData.Worksheets
        If ws.Index > wbData.Sheets("Start").Index And ws.Index < wbData.Sheets("Finish").Index Then
            If (wbResult.Sheets(ws.Index).Name <> ws.Name) Or (ws.Index > Sheets(Sheets.Count).Index - 1) Then
                For Each w In wbResult.Worksheets
                    If w.Name = ws.Name Then blnExists = True
                Next
                If Not blnExists Then
                    wbResult.Sheets.Add.Name = ws.Name
                    i = i + 1
                    ReDim Preserve arrSheetName(0 To i)
                    arrSheetName(i) = ws.Name
                End If
            End If
        End If
    Next

    wbData.Activate

    If wbData.Sheets(1).Name = wbResult.Sheets(1).Name Then
        wbData.Sheets(1).Range("A1:F" & Range("F1048576").End(xlUp).Row).Copy
        wbCurrent.Activate
        Range("A1").PasteSpecial
        SortData
        
        wbResult.Activate
        wbResult.Sheets(1).Range("A3:C3").Copy
        wbCurrent.Activate
        Range("L3:N3").PasteSpecial
        FindValues
        Range("N3:W" & Range("W1048576").End(xlUp).Row).Offset(-1, 0).Copy
        wbResult.Activate
        wbResult.Sheets(1).Range("A3").Insert Shift:=xlDown
        
        wbCurrent.Activate
        Range("L3:N3").ClearContents
        Range("A1:F" & Range("F1048576").End(xlUp).Row).ClearContents
        Range("L4:W" & Range("F1048576").End(xlUp).Row).ClearContents

        
    Else
        wbData.Sheets(1).Range("A1:F" & Range("F1048576").End(xlUp).Row).Copy
        wbCurrent.Activate
        Range("A1").PasteSpecial
        SortData
        If IsArrayAllocated(arrSheetName) Then
            i = 0
            wbResult.Activate
            For i = LBound(arrSheetName) To UBound(arrSheetName) - 1
                If i + 1 > wbResult.Sheets("Finish").Index - 1 Then Exit For
                varData = Split(InputBox("Please enter value for L3:N3 in sheet " & wbResult.Sheets(arrSheetName(i + 1)).Name & ", seperated by a space.", "Data input"), " ")
                wbResult.Sheets(arrSheetName(i + 1)).Range("L3").Value = varData(0)
                wbResult.Sheets(arrSheetName(i + 1)).Range("M3").Value = varData(1)
                wbResult.Sheets(arrSheetName(i + 1)).Range("N3").Value = varData(2)
            Next
        End If

    End If

    wbData.Activate
    SortWorksheets
    wbResult.Activate
    SortWorksheets

    wbData.Close True
    wbResult.Close True

End Sub

Private Sub SortWorksheets()

    Dim N As Integer
    Dim M As Integer
    Dim FirstWSToSort As Integer
    Dim LastWSToSort As Integer
    Dim SortDescending As Boolean

    SortDescending = False

    If ActiveWindow.SelectedSheets.Count = 1 Then
        FirstWSToSort = Worksheets("Start").Index + 1
        LastWSToSort = Worksheets("Finish").Index - 1
    Else
        With ActiveWindow.SelectedSheets
            For N = 2 To .Count
                If .Item(N - 1).Index <> .Item(N).Index - 1 Then
                    MsgBox "You cannot sort non-adjacent sheets"
                    Exit Sub
                End If
            Next N
            FirstWSToSort = .Item(1).Index
            LastWSToSort = .Item(.Count).Index
        End With
    End If

    For M = FirstWSToSort To LastWSToSort
        For N = M To LastWSToSort
            If SortDescending = True Then
                If UCase(Worksheets(N).Name) > UCase(Worksheets(M).Name) Then
                    Worksheets(N).Move Before:=Worksheets(M)
                End If
            Else
                If UCase(Worksheets(N).Name) < UCase(Worksheets(M).Name) Then
                    Worksheets(N).Move Before:=Worksheets(M)
                End If
            End If
        Next N
    Next M

End Sub

Function IsArrayAllocated(Arr As Variant) As Boolean
    On Error Resume Next
    IsArrayAllocated = IsArray(Arr) And _
                       Not IsError(LBound(Arr, 1)) And _
                       LBound(Arr, 1) <= UBound(Arr, 1)
End Function

Sub SortData()

 Dim oneRange As Range
 Dim aCell As Range
 Set oneRange = Range("A3:F" & Range("F1048576").End(xlUp).Row)
 Set aCell = Range("A3")
 oneRange.Sort Key1:=aCell, Order1:=xlAscending, Header:=xlNo

 End Sub

Select allOpen in new window

Thanks

Did you got it what mi trying to achieve? I had added Sub SortData & Sub FindValues in between code which you have provided . & set WB as only match condition is founds. but I am getting no result.

Thanks
Data.xlsm
Process.xlsm
Result.xlsm