This is a follow up on a duration I posted yesterday "Why does this code causes an infinite loop"
Running "SortByEcode" first takes 5.51 seconds
Running "KeepEcode" next takes 1.65 seconds
But if I call "SortByEcode" from within "KeepEcode", KeepEcode takes 4min 54sec to run.
Sub EcodeKeep()
'Needs REH to be sorted first by ECode
TurnOffFunctionality ' Turn off Calculations, DisplayStatusBar, EnableEvents and ScreenUpdating
Dim i As Long
Dim j As Long
Dim LastRow As Long
Dim StartTime As Double
'Sort REH by ECode first
Call SortByEcode 'THIS IS STILL THE BIG PROBLEM
Dim wks As Worksheet
Set wks = rawData5 'Work in sheet("RawEquipHistory")
LastRow = wks.Range("A" & Rows.Count).End(xlUp).Row
StartTime = Timer
Dim Ecodes() As Variant
Ecodes = Application.Transpose(wks.Range("A1:A" & LastRow).Value)
Dim Results As Variant
ReDim Results(UBound(Ecodes) - 1)
wks.Range("AM1") = "ECODE KEEP" 'Add the header to "S1"
For i = LBound(Results) To UBound(Results) - 1
Results(i) = Ecodes(i + 1) <> Ecodes(i + 2)
Next i
'wks.Range("AM2:AM" & i + 1).Value = Results 'I cannot get this line of code to work at all, so added a "write" loop
' outside of maim loop
For j = 0 To i
wks.Range("AM" & j + 2) = Results(j)
Next j
TurnOnFunctionality ' Turn back on at the end
Call EndTimer("EcodeKeep", StartTime)
End Sub
Sub SortByEcode()
TurnOffFunctionality ' Turn off at the start
Dim LastRow As Long
LastRow = ThisWorkbook.Sheets("RawEquipHistory").Range("A" & Rows.Count).End(xlUp).Row
With ThisWorkbook.Sheets("RawEquipHistory").Sort ' SORT sheet by E-Code(a)
.SortFields.Clear
.SortFields.Add Key:=Range("A1:A" & LastRow), Order:=xlAscending
.SetRange Range("A1:AZ" & LastRow)
.Header = xlYes
.Apply
End With
TurnOnFunctionality ' Turn back on at the end
Debug.Print "SortByEcode is Done"
End Sub
Also, I cannot get the line of code provided by Mathieu Guindon #MathieuGuindonto run at all. The code does not kick up any errors but every cell in Range("AM2:AM" & LastRow) equals TRUE. However, if I loop over the Range("AM2:AM" & LastRow)and write the values one at a time I get the correct values.
And if I loop and debug.Pring Results(i) I get the correct results in the immediate window. So I know that the Results array has correct values.
wks.Range("AM2:AM" & i + 1).Value = Results
Related
Okay, so I feel like I am getting closer but I am running in to an object error. I am trying to replace old values in an excel sheet with the new charge values. Here is an example of what I am trying to do.
This is an example of the type of table I might start out with.
This is what I want it to look like after I run the VBA
Here is what I have so far.
Sub Testing()
Dim x As Integer
Dim UpdateRng As Range
Dim SelectRng As Range
v = 2
Application.ScreenUpdating = False
' Get count
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
Range("B2").Select
' Cycle through loop
For x = 1 To NumRows
Set SelectRng = Range("C" & v & ":" & "F" & v) 'Set range
If "A" & v.Vaule = " " Or v.Value = "" Then GoTo NextV
For Each UpdateRng In SelectRng
If UpdateRng.Value > 0 Then
UpdateRng.Value = Range("A" & v).Value
End If
Next
NextV:
v = v + 1
Next
Application.ScreenUpdating = True
End Sub
Add Option Explicit to the top of the module and declare all variables.
Avoid using GoTo as that generally creates spaghetti code.
Use End(xlUp) to determine the last row.
Avoid using Select.
Use Long instead of Integer.
Sub Testing()
Dim ws As Worksheet
Set ws = ActiveSheet
With ws
Dim lastRow As Long
lastRow = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
Dim i As Long
For i = 2 To lastRow
With ws
If Not IsEmpty(.Range("A" & i).Value) Then
.Range("C" & i & ":F" & i).Replace "*", .Range("A" & i).Value
End If
End With
Next
End Sub
Note that this considers all values when replacing, not just values greater than 0. Though I think the >0 check is essentially checking if the cells in columns C:F are not empty.
I got it working with this. However, Bigben's is much cleaner.
Sub Testing()
Dim x As Integer
Dim UpdateRng As Range
Dim SelectRng As Range
v = 2
Application.ScreenUpdating = False
' Get count
NumRows = Range("B2", Range("B2").End(xlDown)).Rows.Count
Range("B2").Select
' Cycle through loop
For x = 1 To NumRows
Set SelectRng = Range("C" & v & ":" & "F" & v) 'Set range
If Range("A" & v).Value = " " Or Range("A" & v).Value = "" Then GoTo NextV
For Each UpdateRng In SelectRng
If UpdateRng.Value > 0 Then
UpdateRng.Value = Range("A" & v).Value
End If
Next
NextV:
v = v + 1
Next
Application.ScreenUpdating = True
End Sub
I currently have 2 worksheets, for simplicity sake let's call them Sheet1 and Sheet2 in the explanations. In Sheet1 I have around 50k rows of data. I am trying to go through Sheet1 and find unique occurrences in the data set to then transfer across to Sheet2.
Below are the methods I have used so far and their rough estimates for time taken.
Method A - Iterate through Sheet1 with a For loop with the conditional check programmed in VBA, if condition is met - transfer a range of 8 cells on that row to Sheet2. This method completes 60% in 60 minutes.
Method B - I thought that removing the condition check in VBA could speed things up so I created a new column in Sheet1 with an IF statement that returns "Y" if the condition is met. I then iterate through this column and if there is a "Y" - transfer the occurrence across to Sheet2. This weirdly takes longer than method A, namely 50% in 60 mins.
Sub NewTTS()
Dim lRow1 As Long, lRow2 As Long
Dim i As Long
With wsOTS
lRow1 = .Range("E" & .Rows.Count).End(xlUp).Row
For i = lRow1 To 2 Step -1
If .Range("P" & i).Text = "Y" Then
lRow2 = wsTTS.Range("E" & wsTTS.Rows.Count).End(xlUp).Row + 1
wsTTS.Range("E" & lRow2, "AA" & lRow2).Value = .Range("E" & i, "AA" & i).Value
End If
Next i
End With
End Sub
Method C - I then read on another post that the .Find() method is quicker than using For loop method. As such I used a .Find() in the column that returns the "Y" and then transfer event across to Sheet2. This is the fastest method so far but still only completes 75% in 60 mins.
Sub SearchOTS()
Application.ScreenUpdating = False
Dim startNumber As Long
Dim lRow1 As Long, lRow2 As Long
Dim i As Long
Dim startTime As Double
startTime = Time
lRow1 = wsOTS.Range("E" & wsOTS.Rows.Count).End(xlUp).Row
Columns("P:P").Select
Selection.Find(What:="Y", After:=ActiveCell, LookIn:=xlValues, LookAt:= _
xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
, SearchFormat:=False).Activate
startNumber = ActiveCell.Row
lRow2 = wsTTS.Range("E" & wsTTS.Rows.Count).End(xlUp).Row + 1
wsTTS.Range("E" & lRow2, "AA" & lRow2).Value = wsOTS.Range("E" & ActiveCell.Row, "AA" & ActiveCell.Row).Value
For i = 1 To lRow1
Selection.FindNext(After:=ActiveCell).Activate
If ActiveCell.Row = startNumber Then GoTo ProcessComplete
lRow2 = wsTTS.Range("E" & wsTTS.Rows.Count).End(xlUp).Row + 1
wsTTS.Range("E" & lRow2, "AA" & lRow2).Value = wsOTS.Range("E" & ActiveCell.Row, "AA" & ActiveCell.Row).Value
wsOTS.Range("B18").Value = i / lRow1
Next i
ProcessComplete:
Application.ScreenUpdating = True
MsgBox "Complete! Time taken: " & Format(Time - startTime, "hh:mm:ss")
End Sub
Method D - I then read another post saying that the fastest way would be to build an array and then loop through the array. Instead of an array I used a collection (dynamic), and I iterate through Sheet1 and store the row numbers for the occurences. I then loop through the collection and transfer the events across to Sheet2. This method returns 50% in 60 mins.
Sub PleaseWork()
Dim i As Long
Dim lRow1 As Long, lRow2 As Long
Dim myCol As New Collection
lRow1 = wsOTS.Range("E" & wsOTS.Rows.Count).End(xlUp).Row
'build collection of row numbers
For i = 1 To lRow1
If wsOTS.Range("P" & i).Text = "Y" Then
myCol.Add i
End If
Next i
'now go through collection and build TTS
For i = 1 To myCol.Count
lRow2 = wsTTS.Range("E" & wsTTS.Rows.Count).End(xlUp).Row + 1
wsTTS.Range("E" & lRow2, "N" & lRow2).Value = wsOTS.Range("E" & myCol(i), "N" & myCol(i)).Value
Next i
Set myCol = New Collection
End Sub
I am trying to find the fastest way to complete this task but all the methods I have tried are yielding greater than an hour to complete.
Is there anything I am missing here? Is there a faster method?
Accessing a range is abysmally slow, and the cause for your long runtime. If you already know that you are going to read 1000 rows, do not read them one at a time. Instead, pull the whole range in a buffer, then work only with that buffer. Same goes for writing. If you do not know in advance how much you will write, make chunks of e.g. 100 rows length.
(Untested) example:
Sub PleaseWork()
Dim i As Long, j as long
Dim lRow1 As Long, lRow2 As Long
Dim myCol As New Collection
Dim column_p() as variant
dim inbuffer() as Variant
dim outbuffer() as variant
lRow1 = wsOTS.Range("E" & wsOTS.Rows.Count).End(xlUp).Row
' Get whole Column P at once
column_p = wsOTS.Range("P1").Resize(lRow1, 1).Value
'build collection of row numbers
For i = 1 To lRow1
If column_p(i, 1) = "Y" Then
myCol.Add i
End If
Next i
'now go through collection and build TTS
lRow2 = myCol.Count 'Number of required rows
' get whole input range
inbuffer = wsOTS.Range("E1").Resize(lRow1, 10).Value
' prepare output
ReDim outbuffer(1 to lRow2, 1 to 10)
For i = 1 To myCol.Count
' write into outbuffer
for j = 1 to 10
outbuffer(i, j) = inbuffer(myCol(i), j)
Next
Next i
' Set whole output at once
wsTTS.Range("E1").Resize(lRow2, 10).Value = outbuffer
Set myCol = New Collection
End Sub
did you consider using Remove Duplicates.
Steps:
Copy entire data to a new sheet
On Data tab, choose Remove duplicates
You can record this as a macro as well.
As the title says, match function taking too long. One spreadsheet is 100,000 rows long and it has a bunch of securities that i need to make sure are on another spreadsheet which has 800,000 rows. Below is the code:
FYI i am average in code building so i am pretty rudimentary in terms of laying out my arguments.
Option Explicit
'a lot of dims
StartTime = Timer
Set ShVar = ThisWorkbook.Worksheets("in1")
With wnewwqr
Set OutShVar = wnewwqr.Worksheets("First Sheet")
Set RngConcat = OutShVar.Range("B:B")
Set RngConcatISIN = OutShVar.Range("A:A")
Set OutShVar1 = wnewwqr.Worksheets("Second Sheet")
Set RngConcat1 = OutShVar1.Range("B:B")
Set RngConcatISIN1 = OutShVar1.Range("A:A")
End With
With ShVar
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
End With
For i = 2 To lastrow
With ShVar
If .Range("O" & i).Value = "" Then
.Range("P" & i & ":Q" & i).Value = "No Security" 'Checking for no securities
Else
If Not IsError(Application.Match(.Range("O" & i).Value, RngConcat, 0)) Then
.Range("P" & i).Value = "US" ' writing US when it finds a US security in the confidential workbook
Else
.Range("P" & i).Value = "Not a US Security"
End If
End If
If .Range("P" & i).Value = "Not a US Security" Then
If Not IsError(Application.Match(.Range("O" & i).Value, RngConcat1, 0)) Then 'Only searching for securities if the first vlookup resulted in nothing and then it would go into the second sheet
.Range("Q" & i).Value = "US"
Else
.Range("Q" & i).Value = .Range("P" & i).Value
End If
End If
End With
Next i
SecondsElapsed = Round(Timer - StartTime, 2)
'Notify user in seconds
MsgBox "This code ran successfully in " & SecondsElapsed & " seconds", vbInformation
End Sub
Update:
I have turned everything to variant and now using find function but still not that fast as i would have hoped. Took 14 mins approx. to do a trial run of 2000 rows. And i have to do this on 90,000 rows
Option Explicit
Sub something
Dim lastrow As Long
Dim OutShVar As Worksheet
Dim ShVar As Worksheet
Dim WhatCell As Range
Dim i As Long
Dim TaskID As Variant
Dim confidentialfp As String
Dim confidential As String
Dim wconfidential As Workbook
Dim x As Variant
Set ShVar = ThisWorkbook.Worksheets("in1")
With ShVar
lastrow = .Cells(.Rows.Count, "H").End(xlUp).Row
End With
confidential = "confidential_2018-03-01 (Consolidated).xlsx"
Set wconfidential = Workbooks(confidential)
With wconfidential
Set OutShVar = .Worksheets("First Sheet")
End With
With ShVar
For i = 1 To lastrow
TaskID = ShVar.Range("O" & i).Value
Set x = .Range("A" & i)
Set WhatCell = OutShVar.Range("B:B").Find(TaskID, lookat:=xlWhole)
On Error Resume Next
x.Offset(0, 7).Value = WhatCell.Offset(0, 1)
Next i
End With
End Sub
I'm not sure you're quite getting ScottCraner's point. What he's saying is you should read all of your reference values (ie the big list of securities) into a couple of arrays, and you should write your output values to another array. You'd then write the entire output array to the sheet in one command.
It might also be worth you converting your list of securities to a Collection as that has a very fast 'look-up' capability. There'd be ways of making this much faster, for example by sorting the securities, but you'd need to get into some mathematics for that.
In the example below, this skeleton code shows how it might be done. You should be aware that I didn't bother splitting the two securities lists into two collections, so you'd want to do that yourself if you needed it. I've also put all my test sheets on the same workbook, so adjust the worksheet qualifiers as needed:
Option Explicit
Sub RunMe()
Dim securities As Collection
Dim testSheet As Worksheet
Dim testItems As Variant
Dim i As Long
Dim exists As Boolean
Dim output() As Variant
'Read the first list of securities into the collection.
PopulateColumnCollection _
ThisWorkbook.Worksheets("First Sheet"), _
"B", _
securities
'Read the second list of securities into the collection.
'I've used the same collection in this example, you'll need
'to create two if you want separate columns in your output.
PopulateColumnCollection _
ThisWorkbook.Worksheets("Second Sheet"), _
"B", _
securities
'Read the test items into an array.
Set testSheet = ThisWorkbook.Worksheets("in1")
With testSheet
testItems = RangeTo2DArray(.Range( _
.Cells(2, "O"), _
.Cells(.Rows.Count, "O").End(xlUp)))
End With
'Prepare your output array.
'I've just used one column for output. If you want two then
'you'll need to resize the second dimension.
ReDim output(1 To UBound(testItems, 1), 1 To 1)
'Populate the output array based on the presence of
'a matching security.
For i = 1 To UBound(testItems, 1)
If IsEmpty(testItems(i, 1)) Then
output(i, 1) = "No Security"
Else
exists = False: On Error Resume Next
exists = securities(CStr(testItems(i, 1))): On Error GoTo 0
output(i, 1) = IIf(exists, "US", "Not a US Security")
End If
Next
'Write the output array to your sheet.
testSheet.Cells(2, "P").Resize(UBound(output, 1), UBound(output, 2)).Value = output
End Sub
Private Function RangeTo2DArray(rng As Range) As Variant
'Helper function to read range values into an array.
Dim v As Variant
Dim arr(1 To 1, 1 To 1) As Variant
v = rng.Value2
If Not IsArray(v) Then
arr(1, 1) = v
RangeTo2DArray = arr
Else
RangeTo2DArray = v
End If
End Function
Private Sub PopulateColumnCollection(ws As Worksheet, columnIndex As String, col As Collection)
'Helper sub to read a column of values into a collection.
Dim rng As Range
Dim v As Variant
Dim i As Long
With ws
Set rng = .Range( _
.Cells(1, columnIndex), _
.Cells(.Rows.Count, columnIndex).End(xlUp))
End With
v = RangeTo2DArray(rng)
If col Is Nothing Then Set col = New Collection
On Error Resume Next 'this avoids duplicates.
For i = 1 To UBound(v, 1)
col.Add True, CStr(v(i, 1))
Next
End Sub
I have the following question.
In the below code i am trying to get my sub to run a loop after the if then statement, and then have the code go back to the first loop and start from the next i. In my below code,everything works fine, but when the condition in the first IF- statement is met, it starts the second loop, but then imidiately exits it again without running it.
So my question is, how do you make a loop after the then statement in a IF- statement?
Sub Sort3()
Dim i As Integer
Dim LastRow As Long
Dim lenght As String
Dim LastRow_2 As String
Dim L_text As Variant
Dim R_text As Variant
Dim M_text As Variant
ThisWorkbook.Sheets("EQ_CLEAN").Select
LastRow = Range("G" & Rows.Count).End(xlUp).Row
LastRow_2 = Range("J" & Rows.Count).End(xlUp).Row
For i = 2 To LastRow
lenght = Range("G" & i)
If Len(lenght) = 25 Then
L_text = Left(Range("A" & i), 12)
R_text = Right(Range("A" & i), 12)
For x = 2 To Last_row_2
On Error Resume Next
n = Worksheets("EQ_CLEAN").Range("D1:D6000").Cells.SpecialCells(xlCellTypeConstants).Count
If L_text <> Sheets("EQ_CLEAN").Range("J" & x) Then
Sheets("EQ_CLEAN").Range(Cells(x, 1), Cells(x, 2)).Select
Application.CutCopyMode = False
Selection.Copy
Range("D" & (n + 1)).Select
Selection.PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
End If
Next x
End If
Next i
End Sub
Always use Option Explicit at the beginning. That would have flagged up to you that you dim and set LastRow_2, and then try to use Last_row_2...
Code Review
I don't think your question applies to your problem after careful review of your code. You had many errors present which I've corrected for you below:
Option Explicit
Sub Sort3()
Dim ws As Worksheet: Set ws = ThisWorkbook.Sheets("EQ_CLEAN")
Dim LastRow As Long, LastRow_2 As Long
Dim lenght As String
Dim L_text As String, R_text As String, M_text As String
Dim n As Long, x As Long, i As Long
LastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
LastRow_2 = ws.Cells(ws.Rows.Count, "J").End(xlUp).Row
For i = 2 To LastRow
lenght = ws.Range("G" & i).Value
If Len(lenght) = 25 Then
L_text = Left(ws.Range("A" & i).Value, 12)
R_text = Right(ws.Range("A" & i).Value, 12)
For x = 2 To LastRow_2
'On Error Resume Next 'You should never use this unless you know exactly which error
'is popping up and why it can't be avoided. Usually this is for 1004 errors that occur
'outside of excel... It's better to use proper error handling instead of skipping all errors.
'You also never tell excel to recognize errors via On Error GoTo 0. I advise you stay away
'from handling errors with these two statements.
'don't make it a habit to assign rogue variables values
n = ws.Range("D1:D6000").Cells.SpecialCells(xlCellTypeConstants).Count
If L_text <> ws.Range("J" & x).Value Then
ws.Range(ws.Cells(x, 1), ws.Cells(x, 2)).Copy
ws.Range("D" & (n + 1)).PasteSpecial Paste:=xlPasteFormulas, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = xlCopy 'this is the proper format to remove the marching ants
End If
Next x
End If
Next i
End Sub
I tried to put comments where changes were made.
I ran your code on a blank sheet and it doesn't throw any errors. See if it achieves what you're looking for.
Literature To Reference
Error Handling
Avoiding Use of .Select
What Microsoft says about Option Explicit
Why I changed your Row based variables to Long
I have an Excel file with around 100,000 records. I have 6+ columns, the first five of which are:
Required Format:
So far I have :
Sub Main()
Dim i As Long
Dim j As Long
Dim sameRows As Boolean
sameRows = True
For i = 1 To Range("A" & Rows.Count).End(xlUp).Row
For j = 1 To 4
If StrComp(Cells(i, j), Cells(i + 1, j), vbTextCompare) Then
sameRows = False
End If
Next j
If sameRows Then
Range(Cells(i, 4), Cells(i + 1, 4)).merge
End If
sameRows = True
Next i
End Sub
I am able to get below by running the macro by changing value in Range from 4 to 1/2/3/4 and running macro four times.
Please help me get the data in required format. I still need to merge the empty fields with the previous non empty field.
Pratik, listen carefully to Jeeped. Working with large data in Excel isn't ideal, and working with raw data in merged cells is staring into the abyss - it's a dark, dark place where Range referencing and things like Offset functions will show you a dimension of despair you never knew existed.
If you have this data in another format, say XML, that you've imported into Excel then use VBA to read the data, query it, etc. in its original format. If it exists in a database, then, again, use VBA to access that database and manipulate the recordsets as you wish. If this is your only source of data, then why not write it into an XML document or into VBA's own data storage options (like Collection or arrays).
If you have to use Excel then don't confuse raw data with data display. Yes, the merged cells might be easier to read for the human eye, but I'd just pose the question: is that your primary objective in conducting the merge?
If you must take that leap into the abyss - and you can see that at least two of us would advise against - then at least speed things up by reading from an array and merging rows at a time:
Sub OpenDoorsToHades()
Dim dataSheet As Worksheet
Dim v As Variant
Dim mergeCells As Range
Dim mergeAreas As Range
Dim i As Long
Dim blankStart As Long
Dim blankEnd As Long
Dim doMerge As Boolean
Dim c As Integer
Set dataSheet = ThisWorkbook.Worksheets("data") 'rename to your sheet
'Read values into array of variants
With dataSheet
v = .Range("A1", .Cells(.Rows.Count, "A").End(xlUp)).Value2
End With
'Check for blanks
For i = 1 To UBound(v, 1)
If IsEmpty(v(i, 1)) Then
If Not doMerge Then
blankStart = i - 1
doMerge = True
End If
Else
If doMerge Then
blankEnd = i - 1
For c = 1 To 4
With dataSheet
Set mergeCells = .Range( _
.Cells(blankStart, c), _
.Cells(blankEnd, c))
If mergeAreas Is Nothing Then
Set mergeAreas = mergeCells
Else
Set mergeAreas = .Range(mergeAreas.Address & _
"," & mergeCells.Address)
End If
End With
Next
mergeAreas.Merge
Set mergeAreas = Nothing
doMerge = False
End If
End If
Next
'Format the sheet
dataSheet.Cells.VerticalAlignment = xlCenter
Application.ScreenUpdating = True
End Sub
How about just populating the empty cells with the values above, so the values on the far right are associated with the same values that would've been in the merged cell. For example, if 19 is in cell A2, you can recreate the table starting in G2 with =IF(A2<>"",A2,G1), and this way all empty cells will be populated with the value above, pairing the values at the far right with the exact same values.
I tackled the same problem myself this week. Ambie's solution seemed overly complex, so I wrote something pretty simple to merge rows:
Sub MergeRows()
Sheets("Sheet1").Select
Dim lngStart As Long
Dim lngEnd As Long
Dim myRow As Long
'Disable popup alerts that appear when merging rows like this
Application.DisplayAlerts = False
lngStart = 2
lngEnd = 2
For myRow = 2 To Range("A" & Rows.Count).End(xlUp).Row 'last row
If Range("A" & (myRow + 1)).value = "" Then
'include row below in next merge
lngEnd = myRow + 1
Else
'merge if 2+ rows are included
If lngEnd - lngStart > 0 Then
Range("A" & lngStart & ":A" & lngEnd).Merge
Range("B" & lngStart & ":B" & lngEnd).Merge
Range("C" & lngStart & ":C" & lngEnd).Merge
Range("D" & lngStart & ":D" & lngEnd).Merge
End If
'reset included rows
lngStart = myRow + 1
lngEnd = myRow + 1
End If
Next myRow
Application.DisplayAlerts = True
End Sub