?
Solved

Simple Excel VBAF

Posted on 2014-04-07
11
1 solution
Medium Priority
?
166 Views
Last Modified: 2014-04-22
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
0
Comment
Question by:Naresh Patel
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
Join The Community
  • 7
  • 4
11 Comments
 
LVL 27

Accepted Solution

by:
MacroShadow earned 2000 total points
ID: 39982887
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
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39983080
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
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39983306
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
Independent Software Vendors: We Want Your Opinion

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Take Survey Now!
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39983331
I give you full description with screen shots just tell me which part you dint understand?
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39983392
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
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39985657 
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
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39985662
remove the period before range
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39985682
Period...?
0
 
LVL 27

Expert Comment

by:MacroShadow
ID: 39985686
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
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39985793
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
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39985841
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

Featured Post

Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

Take Survey Now!
Question has a verified solution.

If you are experiencing a similar issue, please ask a related question
How to Install Microsoft Office Picture Manager in Office 2016/Office 365
Article by: Joe
Microsoft Office Picture Manager was included in Office 2003, 2007, and 2010, but not in Office 2013. Users had hopes that it would be in Office 2016/Office 365, but it is not. Fortunately, the same zero-cost technique that works to install it with …
Forecasting in Excel 2016 for Windows and Mac
Article by: Bob
If you need to forecast numbers -- typically for finance -- the Windows and Mac versions of Excel 2016 have a basket of tools to get the job done.
Working with Templates
Video by: Tony
This video shows where to find templates, what they are used for, and how to create and save a custom template using Microsoft Word.
How to export Office 365 mailboxes to PST using eDiscovery
Video by: CodeTwo
In this video you will find out how to export Office 365 mailboxes using the built in eDiscovery tool. Bear in mind that although this method might be useful in some cases, using PST files as Office 365 backup is troublesome in a long run (more on t…
Advertise Here

770 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Advertise Here