Simple Excel VBAF

Hi Experts,

I have two piece of Code which I have in two different module . I want to run code 2 in code 1.At 2 stages (IF & Else) end. And add few more steps in code 1. 
 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

        wbResult.Activate
        wbResult.Sheets(1).Range("A3:C3").Copy
        wbCurrent.Activate
        Range("L3:N3").PasteSpecial

Open in new window

Above code Copy data from other sheet & past to Current WB - I want add few things after @ if end
Copied data sort in oldest to newest date wise (Column A)
Run Sub FindValues() (Module – “ZigZag”)  
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.
& Clear Data (A1:F end row, L4:W till end, L3:N3)
Else
        wbData.Sheets(1).Range("A1:F" & Range("F1048576").End(xlUp).Row).Copy
        wbCurrent.Activate
        Range("A1").PasteSpecial

        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)

Open in new window

& in above code sheet name doesn’t found & it is else statement.
It copies data from Data WB & put manually L3:N3 values via input box. I want in this flow.
I want  on copied data sort oldest to newest date wise (Column A)
Manual entry of range L3:N3 via input box
Run Sub FindValues() (Module – “ZigZag”)  
Copy data L1:W till end & past to new created sheet A1.
& Clear Data (A1:F end row, L4:W till end, L3:N3)

This is whole Code 
Option Explicit

Sub Demo()

    Dim wbCurrent As Workbook, wbData As Workbook, wbResult As Workbook
    Dim ws As Worksheet, 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

        wbResult.Activate
        wbResult.Sheets(1).Range("A3:C3").Copy
        wbCurrent.Activate
        Range("L3:N3").PasteSpecial
    Else
        wbData.Sheets(1).Range("A1:F" & Range("F1048576").End(xlUp).Row).Copy
        wbCurrent.Activate
        Range("A1").PasteSpecial

        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

Open in new window


Thanks & Any confusion revert me back. Sun FindValues is in attached WB Process.
Data.xlsm
Process.xlsm
Result.xlsm
LVL 8
Naresh PatelTraderAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

MacroShadowCommented:
Somethings I understand and some I don't.

Copied data sort in oldest to newest date wise (Column A)
I want  on copied data sort oldest to newest date wise (Column A)
You only copy 3 adjacent cells, I'm not sure what data you want sorted.

Copy L3:W end row except last row & past to related sheet.
Please name workbook and worksheets.

But after shift row down data which is exist in sheet from A3.
Not sure what you mean, please explain in simple English.

Manual entry of range L3:N3 via input box
You have that already

Run Sub FindValues() (Module – “ZigZag”)
Since you want this code to run in both cases (if and else) add call findvalues after end if

Copy data L1:W till end & past to new created sheet A1.
Copy from which sheet and paste to which sheet?

& Clear Data (A1:F end row, L4:W till end, L3:N3)
You just pasted it, why clear it, if want to clear it don't paste it.
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
Naresh PatelTraderAuthor Commented:
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.

Before SortAfter Sort
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.

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

Thanks
0
MacroShadowCommented:
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!
0
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

Download your Guide
Naresh PatelTraderAuthor Commented:
I give you full description with screen shots just tell me which part you dint understand?
0
Naresh PatelTraderAuthor Commented:
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
0
Naresh PatelTraderAuthor Commented: 
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

Open in new window


I had added some line via online searching for IF Match found statement but it flashes errorErrorI 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

Open in new window


Thanks
Process.xlsm
0
MacroShadowCommented:
remove the period before range
0
Naresh PatelTraderAuthor Commented:
Period...?
0
MacroShadowCommented:
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
0
Naresh PatelTraderAuthor Commented:
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

Open in new window


Thanks
0
Naresh PatelTraderAuthor Commented:
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
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Office

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.