Naresh Patel
asked on
Simple Excel VBA
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.
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.
Thanks
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)
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
Thanks
ASKER
life got in the way...
???? "Candy Crush" ;)
ASKER
Off the Desk for 2 hours. way back to home.
Thanks
Thanks
That's your mistake, I just copied the code from above!
Add:
Add:
Dim varData() As String
Thumbs up for including the error :)
ASKER
Mr.MacroShadow,
I will check this code tomorrow, here too late & my kid don't allow me to seat in front of computer.
Thanks
I will check this code tomorrow, here too late & my kid don't allow me to seat in front of computer.
Thanks
ASKER
Online?
Yep.
ASKER
ASKER
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
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
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
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?
ASKER
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 ??? ;)
You Are Not Sleeping ??? ;)
ASKER
Did You Seen My This Comment?
Couldn't write this if I was sleeping ...
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.
ASKER
Sorry wrong question "You don't Sleep?" :)
ASKER
okie
You don't Sleep?Only sometimes ...
Copy L3:N3 from WB Process & Past To this new sheet - location A3:C3.When is this supposed to happen?
ASKER
This Situation occur when there is No sheet found in Result WB . so After Input box entry.
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?
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?
ASKER
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
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
ASKER
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
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
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
what is the error message?
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
at time of error what is the value of:
1. x
2. arrSheetName(x)
1. x
2. arrSheetName(x)
ASKER
i guess C - & A B sheet also created with no data
???
ASKER
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
ASKER
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
i am off the desk for 2 hours. Next question link is last question on this series.
Thanks
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?
?x
Then hit enter. what is the result?
next type:
?arrSheetName(x)
Then hit enter. what is the result?
Anybody home?
ASKER
it is working properly on your machine?
ASKER
hold on i had done this in old file which is saved in my home machine. now executing from pendrive.
I'm clocking out for the next 30 hours or so, I'll be back after that.
ASKER
okie happy week end cheers!!!!
ASKER
online?
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
What is the error?
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
please send me the relevant files so I can test it.
ASKER
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
ASKER
Let see what happen on my machine.Going for Prayer.
Revert you back soon.
Thanks
Revert you back soon.
Thanks
Long prayers ;)
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
ASKER
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
Thanks
ASKER
Do u want me to close this question and play with real data?
You want to be prompted for each sheet?
ASKER
Yes
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
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks.
ASKER
May I Ask New Question ...it will take 20 min...?
Go ahead!
ASKER
May I Post New Question Now?
Go ahead! I've been waiting for the past 3 hours!
ASKER
ASKER
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
Thanks
This should do it:
Open in new window