Want to protect your cyber security and still get fast solutions? Ask a secure question today.Go Premium

x
?
Solved

Simple Excel VBA

Posted on 2014-04-03
72
Medium Priority
?
196 Views
Last Modified: 2014-04-07
Hi experts,

I have code which match sheets names of two WB from Third WB & perform some task.
I want to add some procedure - if WB Data - sheet x (X is just assumption) not match in WB Results - Sheets then.

this  is already there in code just for understanding.
Else
        wbData.Sheets(1).Range("A1:F" & Range("F1048576").End(xlUp).Row).Copy
        wbCurrent.Activate
        Range("A1").PasteSpecial

        varData = Split(InputBox("Please enter value for L3:N3, seperated by a space.", "Data input"), " ")

        wbCurrent.Sheets(1).Range("L3").Value = varData(0)
        wbCurrent.Sheets(1).Range("M3").Value = varData(1)
        wbCurrent.Sheets(1).Range("N3").Value = varData(2)

Open in new window


After this - create new sheet in WB Result (name is same as WB Data - Sheet Name)
                   Copy L3:N3 from WB Process & Past To this new sheet - location A3:C3.

this my original whole code.
Sub Demo()

    Dim wbCurrent As Workbook, wbData As Workbook, wbResult As Workbook

    Set wbCurrent = ActiveWorkbook
    Set wbData = Workbooks.Open("H:\4.Trading Master\Thunderbolt\Simple Excel Formula\Data.xlsx")
    wbData.Activate
    SortWorksheets
    Set wbResult = Workbooks.Open("H:\4.Trading Master\Thunderbolt\Simple Excel Formula\Result.xlsx")
    wbResult.Activate
    SortWorksheets

    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

        varData = Split(InputBox("Please enter value for L3:N3, seperated by a space.", "Data input"), " ")

        wbCurrent.Sheets(1).Range("L3").Value = varData(0)
        wbCurrent.Sheets(1).Range("M3").Value = varData(1)
        wbCurrent.Sheets(1).Range("N3").Value = varData(2)
    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 = 3
        LastWSToSort = Worksheets.Count - 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

Open in new window



Thanks
0
Comment
Question by:Naresh Patel
  • 41
  • 31
72 Comments
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39974910
Sorry for the delay, life got in the way...

This should do it:
Option Explicit


Sub Demo()

    Dim wbCurrent As Workbook, wbData As Workbook, wbResult As Workbook

    Set wbCurrent = ActiveWorkbook
    Set wbData = Workbooks.Open("H:\4.Trading Master\Thunderbolt\Simple Excel Formula\Data.xlsx")
    wbData.Activate
    SortWorksheets
    Set wbResult = Workbooks.Open("H:\4.Trading Master\Thunderbolt\Simple Excel Formula\Result.xlsx")
    wbResult.Activate
    SortWorksheets

    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

        varData = Split(InputBox("Please enter value for L3:N3, seperated by a space.", "Data input"), " ")

        wbCurrent.Sheets(1).Range("L3").Value = varData(0)
        wbCurrent.Sheets(1).Range("M3").Value = varData(1)
        wbCurrent.Sheets(1).Range("N3").Value = varData(2)
        
        wbResult.Activate
        Sheets.Add.Name = wbData.Sheets(1).Name
        
        wbCurrent.Activate
        wbCurrent.ActiveSheet.Range("L3:N3").Copy
        
        wbResult.Activate
        Range("A3:C3").PasteSpecial
    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 = 3
        LastWSToSort = Worksheets.Count - 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

Open in new window

0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39974921
life got in the way...

???? "Candy Crush" ;)
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39975008
Error
0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 8

Author Comment

by:Naresh Patel
ID: 39975052
Off the Desk for 2 hours. way back to home.

Thanks
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39975171
That's your mistake, I just copied the code from above!

Add:
Dim varData() As String

Open in new window

0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39975175
Thumbs up for including the error :)
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39975931
Mr.MacroShadow,
I will check this code tomorrow, here too late & my kid don't allow me to seat in front of computer.

Thanks
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977211
Online?
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977215
Yep.
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977218
ok I had tested your code thing is that it create new sheet in name of "Ticker" & then Error.Ticker Sheet CreatedError
Thanks
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977234
In short I want code perform in Process WB.
it match each sheet from WB Data to each sheet in WB Result.
if found then ..... else ......already mention in the code as you are the creator of this code.
you know very well.

so at the end of this Sub Demo ()

my both WB Data & Result have same number of Sheets with same names. (Between Sheet "Start - Finish"

Note : - Only Match Sheets which is Between Sheets "Start" - Finish" in both WB (Data & Result)

Thanks
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977245
After this - create new sheet in WB Result (name is same as WB Data - Sheet Name)

That's what this line does:
Sheets.Add.Name = wbData.Sheets(1).Name

Open in new window

It creates a new sheet in result workbook with the same name as the first sheet in the data workbook.

If that isn't what you want please explain what you do.

And once again please include the error message, how am I to know what the problem is?
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977248
One More Thing I Noticed You Posted Your Comment @Yesterday morning thru out  Evening to me @ Night @ Mid night to other Author @ you are still online.

You Are Not Sleeping ??? ;)
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977250
Did You Seen My This  Comment?
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977251
Couldn't write this if I was sleeping ...
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977254
Slow down, You don't give me a chance to respond between your posts. I'm heading out for about 20 minutes, I'll resume when I come back.
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977256
Sorry wrong question "You don't Sleep?" :)
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977260
okie
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977280
You don't Sleep?
Only sometimes ...
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977287
Copy L3:N3 from WB Process & Past To this new sheet - location A3:C3.
When is this supposed to happen?
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977296
This Situation occur when there is No sheet found in Result WB . so After Input box entry.
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977379
I'm still not sure exactly what you want.

1. When do you want to compare and add the missing sheets  to the Result workbook?
2. When do you want to copy L3:N3 from the Process workbook?
3. In which sheet should those values be pasted?
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977410
1. When do you want to compare and add the missing sheets  to the Result workbook?
When? I want it compare all sheet from Sheet "Start- Finish" so there is no event when to compare it, is like counter do it for all sheet. if result WB have then IF Code part. else Else Code Part.
2. When do you want to copy L3:N3 from the Process workbook?
It is after I manually enter "Input Box Values Space separated". This will happen in criteria when then is no match found in sheet between Data WB & Result WB.
3. In which sheet should those values be pasted?
New Sheet which created (when No match found).

I know you are beating the bush & wondered what mi achieving by this.
But in next question total picture will clear to you. in which whole actual data is there not like 100 200 300 & A B C.

Thanks
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977481
Try this:
Option Explicit

Sub Demo()

    Dim wbCurrent As Workbook, wbData As Workbook, wbResult As Workbook
    Dim ws As Worksheet
    Dim varData() As String
    Dim strSheetName As String
    
    Set wbCurrent = ActiveWorkbook
    Set wbData = Workbooks.Open("H:\4.Trading Master\Thunderbolt\Simple Excel Formula\Data.xlsx")
    
    wbData.Activate
    SortWorksheets
    
    Set wbResult = Workbooks.Open("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 Then
                wbResult.Sheets.Add.Name = ws.Name
                strSheetName = ws.Name
            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

        varData = Split(InputBox("Please enter value for L3:N3, seperated by a space.", "Data input"), " ")

        wbCurrent.Sheets(1).Range("L3").Value = varData(0)
        wbCurrent.Sheets(1).Range("M3").Value = varData(1)
        wbCurrent.Sheets(1).Range("N3").Value = varData(2)
        
        wbCurrent.Activate
        wbCurrent.ActiveSheet.Range("L3:N3").Copy
        
        wbResult.Activate
        wbResult.Sheets(strSheetName).Range("A3:C3").PasteSpecial
        
    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 = 3
        LastWSToSort = Worksheets.Count - 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

Open in new window

0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977520
Sorting  - Creating  is working fine. Now in both WB there is 6 sheets with Name matched.

Only sole issue - i have 6 sheet in Data & Result WB Name " A B C D E F"
                             I had deleted Manually from Result WB "A B C"
                             Run The Code all are created but in "Input message box manual entry"
                             Appear for only one time & these values pasted on Result WB Sheet C.  

Ideally it must ask for all three sheet which are created i .e  A B C

Thanks
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977578
Try this:
Option Explicit

Sub Demo()

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

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

    wbData.Activate
    SortWorksheets

    Set wbResult = Workbooks.Open("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 Then
                wbResult.Sheets.Add.Name = ws.Name
                i = i + 1
                ReDim Preserve arrSheetName(0 To i)
                arrSheetName(i) = ws.Name
            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

        varData = Split(InputBox("Please enter value for L3:N3, seperated by a space.", "Data input"), " ")

        wbCurrent.Sheets(1).Range("L3").Value = varData(0)
        wbCurrent.Sheets(1).Range("M3").Value = varData(1)
        wbCurrent.Sheets(1).Range("N3").Value = varData(2)

        wbCurrent.Activate
        wbCurrent.ActiveSheet.Range("L3:N3").Copy

        i = 0
        For i = LBound(arrSheetName) To UBound(arrSheetName)
            wbResult.Activate
            wbResult.Sheets(arrSheetName(i)).Range("A3:C3").PasteSpecial
            i = i + 1
        Next

    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 = 3
        LastWSToSort = Worksheets.Count - 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

Open in new window

0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977584
Error
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977590
what is the error message?
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977601
Press Play Button - Input box AppearInserting valuesError Appear After pressing debug
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977682
How about this:
Option Explicit

Sub Demo()

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

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

    wbData.Activate
    SortWorksheets

    Set wbResult = Workbooks.Open("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 Then
                wbResult.Sheets.Add.Name = ws.Name
                i = i + 1
                ReDim Preserve arrSheetName(0 To i)
                arrSheetName(i) = ws.Name
            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

        varData = Split(InputBox("Please enter value for L3:N3, seperated by a space.", "Data input"), " ")

        wbCurrent.Sheets(1).Range("L3").Value = varData(0)
        wbCurrent.Sheets(1).Range("M3").Value = varData(1)
        wbCurrent.Sheets(1).Range("N3").Value = varData(2)

        wbCurrent.Activate
        wbCurrent.ActiveSheet.Range("L3:N3").Copy

        wbResult.Activate
        For x = LBound(arrSheetName) To UBound(arrSheetName)
            wbResult.Sheets(arrSheetName(x)).Range("A3:C3").PasteSpecial
            x = x + 1
        Next

    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 = 3
        LastWSToSort = Worksheets.Count - 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

Open in new window

0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977685
error
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977689
at time of error what is the value of:
1. x
2. arrSheetName(x)
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977701
i guess C - & A B sheet also created with no data
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977703
???
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977715
at time of error what is the value of:
1. x
2. arrSheetName(x)

How do i find? i said C bcoz at that time result WB is open & Mouse cursor is in C Sheet.

Thanks
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39977766
After This Question Next Question Link.. It is same like what have to done but it with actual data.

i am off the desk for 2 hours. Next question link is last question on this series.

Thanks
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39977792
In the immediate window (ctrl+G to open it) type:

?x

Then hit enter. what is the result?

next type:

?arrSheetName(x)

Then hit enter. what is the result?
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39978154
Anybody home?
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39978297
Sorry For Delay ....my son dont allow me to seat in front of computer. pressing keys.... :)Error
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39978303
it is working properly on your machine?
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39978310
hold on i had done this in old file which is saved in my home machine. now executing  from pendrive.
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39978322
Revised Error
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39978398
I'm clocking out for the next 30 hours or so, I'll be back after that.
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39978401
okie happy week end cheers!!!!
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39980007
online?
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39980307
I hope this will solve your issue:
Option Explicit

Sub Demo()

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

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

    wbData.Activate
    SortWorksheets

    Set wbResult = Workbooks.Open("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 Then
                wbResult.Sheets.Add.Name = ws.Name
                i = i + 1
                ReDim Preserve arrSheetName(0 To i)
                arrSheetName(i) = ws.Name
            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

        varData = Split(InputBox("Please enter value for L3:N3, seperated by a space.", "Data input"), " ")

        wbCurrent.Sheets(1).Range("L3").Value = varData(0)
        wbCurrent.Sheets(1).Range("M3").Value = varData(1)
        wbCurrent.Sheets(1).Range("N3").Value = varData(2)

        wbCurrent.Activate
        wbCurrent.ActiveSheet.Range("L3:N3").Copy

        x = 1
        wbResult.Activate
        For x = LBound(arrSheetName) To UBound(arrSheetName)
            wbResult.Sheets(arrSheetName(x)).Range("A3:C3").PasteSpecial
            x = x + 1
        Next

    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

Open in new window

0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39980869
ERROR
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39980955
What is the error?
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39980980
error
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39980984
Option Explicit

Sub Demo()

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

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

    wbData.Activate
    SortWorksheets

    Set wbResult = Workbooks.Open("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 Then
                wbResult.Sheets.Add.Name = ws.Name
                i = i + 1
                ReDim Preserve arrSheetName(0 To i)
                arrSheetName(i) = ws.Name
            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

        varData = Split(InputBox("Please enter value for L3:N3, seperated by a space.", "Data input"), " ")

        wbCurrent.Sheets(1).Range("L3").Value = varData(0)
        wbCurrent.Sheets(1).Range("M3").Value = varData(1)
        wbCurrent.Sheets(1).Range("N3").Value = varData(2)

        wbCurrent.Activate
        wbCurrent.ActiveSheet.Range("L3:N3").Copy

        wbResult.Activate
        For x = LBound(arrSheetName) To UBound(arrSheetName)
            wbResult.Sheets(arrSheetName(x) + 1).Range("A3:C3").PasteSpecial
            x = x + 1
        Next

    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

Open in new window

0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39981079
Error
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39981083
please send me the relevant files so I can test it.
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39981129
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39981205
Finally working (on my machine):

Option Explicit

Sub Demo()

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

    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
                wbResult.Sheets.Add.Name = ws.Name
                i = i + 1
                ReDim Preserve arrSheetName(0 To i)
                arrSheetName(i) = ws.Name
            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

        varData = Split(InputBox("Please enter value for L3:N3, seperated by a space.", "Data input"), " ")

        wbCurrent.Sheets(1).Range("L3").Value = varData(0)
        wbCurrent.Sheets(1).Range("M3").Value = varData(1)
        wbCurrent.Sheets(1).Range("N3").Value = varData(2)

        wbCurrent.Activate
        wbCurrent.ActiveSheet.Range("L3:N3").Copy

        i = 0
        wbResult.Activate
        For i = LBound(arrSheetName) To UBound(arrSheetName) - 1
            If i + 1 > wbResult.Sheets("Finish").Index - 1 Then Exit For
            wbResult.Sheets(arrSheetName(i + 1)).Range("A3:C3").PasteSpecial
        Next

    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

Open in new window

0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39981223
Let see what happen on my machine.Going for Prayer.

Revert you back soon.

Thanks
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39981430
Long prayers ;)
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39981570
Are You sure Working On Your Machine? i got this ErrorError
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39981579
I'm sorry, pasted the wrong code. This is what it should have been:

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

        varData = Split(InputBox("Please enter value for L3:N3, seperated by a space.", "Data input"), " ")

        wbCurrent.Sheets(1).Range("L3").Value = varData(0)
        wbCurrent.Sheets(1).Range("M3").Value = varData(1)
        wbCurrent.Sheets(1).Range("N3").Value = varData(2)

        wbCurrent.Activate
        wbCurrent.ActiveSheet.Range("L3:N3").Copy

        i = 0
        wbResult.Activate
        For i = LBound(arrSheetName) To UBound(arrSheetName) - 1
            If i + 1 > wbResult.Sheets("Finish").Index - 1 Then Exit For
            wbResult.Sheets(arrSheetName(i + 1)).Range("A3:C3").PasteSpecial
        Next

    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

Open in new window

0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39981601
Yes Working fine from previous errors now no errors but i guess you miss one Point. Input message box ask for manually entry for each sheet which is not in Result.

Thanks
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39981606
Do u want me to close this question and play with real data?
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39981621
You want to be prompted for each sheet?
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39981651
Yes
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39981661
How about this:
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

        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

    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

Open in new window

0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39982216
Error
0
 
LVL 28

Accepted Solution

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

0
 
LVL 8

Author Closing Comment

by:Naresh Patel
ID: 39982233
Thanks.
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39982237
May I Ask New Question ...it will take 20 min...?
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39982239
Go ahead!
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39982521
May I Post New Question Now?
0
 
LVL 28

Expert Comment

by:MacroShadow
ID: 39982644
Go ahead! I've been waiting for the past 3 hours!
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39982653
ooooppppssss Sorrry apology.....New Question.

Thanks
0
 
LVL 8

Author Comment

by:Naresh Patel
ID: 39982798
did you got ? for what mi up too....just put any comment on new question as you know whole history ......if any other will attend -----I have too tell him whole story.

Thanks
0

Featured Post

Get expert help—faster!

Need expert help—fast? Use the Help Bell for personalized assistance getting answers to your important questions.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Microsoft's Excel has many features that most people will never need nor take advantage of.  Conditional formatting is one feature that you may find a necessity once you start using it.
If Skype for Business came with your office 2016 or office 365 installation, you may find that it's almost impossible to either disable or remove it. The application will often launch with each start of Windows, even when explicitly configured not t…
This Micro Tutorial will demonstrate how to create pivot charts out of a data set. I also added a drop-down menu which allows to choose from different categories in the data set and the chart will automatically update.
How can you see what you are working on when you want to see it while you to save a copy? Add a "Save As" icon to the Quick Access Toolbar, or QAT. That way, when you save a copy of a query, form, report, or other object you are modifying, you…

578 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