Your question, your audience. Choose who sees your identity—and your question—with question security.
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
Above code Copy data from other sheet & past to Current WB - I want add few things after @ if end 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)
& in above code sheet name doesn’t found & it is else statement.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
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 boxYou 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.
Copy L3:W end row except last row & past to related sheet.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.
But after shift row down data which is exist in sheet from A3.
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
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
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
Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.
Have a better answer? Share it in a comment.
Join the community of 500,000 technology professionals and ask your questions.