Hello everybody i would really appreciate your help with the following problem:
I have an Excel file that contains an hardware acquisition, with different sampling rate depending on the value (eg. some value acquiried at 100ms and others at 10ms in that case). So i have the first column with Time value (every cell is 10ms) and the following columns with the other acquiried values. Every column that corresponds to the 100ms acquisition frequency shows 10 blank cell after filled cell (while the 10ms ones are full). Now my question is:
What's the best whay to filter all the values and create a new table with only value took every 1s?
Thanks.
Here's a screenshot (simplified)
Image of the file
I would just use a couple of loops like this
Option Explicit
Sub CopySeconds()
Dim FirstRow, LastRow, inRow, inCol, outRow, outCol, colShift As Variant
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
FirstRow = 4
outRow = FirstRow
colShift = 10
For inRow = FirstRow To LastRow
If Not IsEmpty(Cells(inRow, 1)) And Int(Cells(inRow, 1)) = Cells(inRow, 1) Then
For inCol = 1 To 4
outCol = inCol + colShift
Cells(outRow, outCol) = Cells(inRow, inCol)
Next inCol
outRow = outRow + 1
End If
Next inRow
End Sub
Related
I have created a large VBA program to automate creation of a data table that is needed to run slicers in an Excel file. While the loop works well in creating what I need. The main loop take an hour to create the list of company names that I need. I was wondering if there is a way to improve the time it takes for the loop to complete. I have 191 rows that need to be copied and then pasted 68 times each into the new sheet. I have tried a few different approaches to improve the time and have only reduced the time required to about 50 minutes. Any help would be much appreciated. I know that using select is horrible for time efficiency but all the other options I have tried have not worked well.
Dim rng As Range, cell As Range
For Each cell In rng
Sheets("Input Data").Select
cell.Select
cell.Copy
Sheets("TrialSheet").Select
For i = 1 To 68
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & LastRow).Select
ActiveSheet.Paste
Next i
Sheets("Input Data").Select
Next cell
Instead of copying and pasting cells, read them once into memory into a 2-dimensional array and write the array into the destination. That speeds up the process dramatically.
Drawback (or advantage, depending on your needs): Only the values are copied.
Sub CopyRange(sourceRange As Range, destRange As Range, Optional howOften As Long = 1)
Dim arr As Variant
' Fill arr with all values of sourceRange
arr = sourceRange.Value2
' Adjust size of destination range
Set destRange = destRange.Resize(sourceRange.Rows.count, sourceRange.Columns.count)
Dim i As Long
For i = 1 To howOften
' Copy the values to the destination
destRange.Value2 = arr
' Move to the next place
Set destRange = destRange.Offset(sourceRange.Rows.count)
Next
End Sub
Assuming that rng is set to the range you want to copy, the call to the routine can look like
call CopyRangeSheets(rng, ThisWorkbook.Sheets("TrialSheet").Range("A1"), 68)
Please remove the last Sheets("Input Data").Select - that is unnecessary, as the loop begins with that.
Secondly, the internal for loop can be replaced with this operation that fills a range in batch:
LastRow = ActiveSheet.Cells(Rows.Count, "A").End(xlUp).Row + 1
Range("A" & LastRow & ":A" & LastRow + 68).PasteSpecial
I think it should be faster, but further adjustments might be necessary.
Since no information was available about the size of source range being copied
Following grey areas of the question is assumed as follows
Since 191 Rows X 68 copy X 3 columns take around 10 minutes only (with you code), the range is about 191 Rows X 15 Columns in size
since it has been claimed that code is working Correctly. The Cells of the range (irrespective of their row or column positions) is being copied in column A only (below one and another). Though it contradicts the statement "automate creation of a data table"
Since the cells of the ranges are being copied and pasted. In test case formulas are copied only.
So the code below will just replicate what your code is doing with some increased efficiency. As I personally don't prefer to keep calculations, event processing and screen updating off (in normal cases) i haven't added that standard lines. However you may use these standard techniques, depending on the working file condition. Make necessary changes regarding Range etc
Code takes only 2-3 seconds to complete with 191 Rows X 15 columns X 68 Copies:
Sub test()
Dim SrcWs As Worksheet, DstWs As Worksheet, SrcArr As Variant
Dim Rng As Range, cell As Range, DstArr() As Variant
Dim X As Long, Y As Long, Z As Long, i As Long, LastRow As Long
Dim Chunk60K As Long
Dim tm As Double
tm = Timer
Set SrcWs = ThisWorkbook.Sheets("Input Data")
Set DstWs = ThisWorkbook.Sheets("TrialSheet")
Set Rng = SrcWs.Range("A1:O191")
SrcArr = Rng.Formula
LastRow = DstWs.Cells(Rows.Count, "A").End(xlUp).Row + 1
Chunk60K = 0
Z = 1
For X = 1 To UBound(SrcArr, 1)
For Y = 1 To UBound(SrcArr, 2)
For i = 1 To 68
ReDim Preserve DstArr(1 To Z)
DstArr(Z) = SrcArr(X, Y)
If Z = 60000 Then ' To Overcome 65K limit of Application.Transpose
DstWs.Range("A" & Chunk60K * 60000 + LastRow).Resize(UBound(DstArr, 1), 1).Formula = Application.Transpose(DstArr)
Chunk60K = Chunk60K + 1
Z = 1
ReDim DstArr(1 To 1)
Debug.Print "Chunk: " & Chunk60K & " Seconds Taken: " & Timer - tm
Else
Z = Z + 1
End If
Next i
Next Y
Next X
If Z > 1 Then DstWs.Range("A" & Chunk60K * 60000 + LastRow).Resize(UBound(DstArr, 1), 1).Formula = Application.Transpose(DstArr)
Debug.Print "Seconds Taken: " & Timer - tm
End Sub
Just started a new job. I'm automating a month-end report and I'm new at VBA. Been googling most of my issues with success, but I've finally run into a wall. In essence I'm downloading some data from SAP and from there I need to build a report.
My question is: How to do a sumif function using loops in VBA?
Data pull:
Sheet1 contains a product code and purchase amounts (columns A & B) respectively. One product code can have several purchases (several rows with the same product code).
Steps so far:
I arranged the data sheet1 to be in ascending order.
Copied unique values for the product codes onto another sheet (sheet2). So Sheet2 has a list of all the products (in ascending order).
I want to get the sum of all purchases in sheet2 column B (per product code). I know how to do this using formulas, but I need to automate this as much as possible. (+ I'm genuinely interested in figuring this out)
This is what I did in VBA so far:
Sub Macro_test()
Dim tb As Worksheet
Dim tb2 As Worksheet
Dim x As Integer
Dim y As Integer
Dim lrow As Long
Set tb = Sheets("sheet1")
Set tb2 = Sheets("sheet2")
lrow = tb.Cells(Rows.Count, "A").End(xlUp).Row
For x = 2 To lrow
For y = 2 To lrow
If tb2.Cells(x, 1).Value = tb.Cells(y, 1).Value Then
tb2.Cells(x, 2).Value = tb.Cells(y, 2).Value
End If
Next y
Next x
End Sub
If i'm not mistaken, for each product_code in sheet2 col A, I'm looping through all the product codes in sheet1 and getting back the LAST value it finds, instead of the sum of all values... I understand why it doesn't work, I just don't know how to fix it.
Any help would be much appreciated. Thanks!
This statement overwrites the value of tb2.Cells(x, 2).Value at each iteration:
tb2.Cells(x, 2).Value = tb.Cells(y, 2).Value
Instead, I think you need to keep adding to it:
tb2.Cells(x, 2).Value = tb2.Cells(x, 2).Value + tb.Cells(y, 2).Value
But I don't like the looks of your double-loop which uses only one lrow variable to represent the "last row" on the two different worksheets, that could be causing some issues.
Or, in your loop do something like this which I think will avoid the duplicate sum. Still, assumes the second worksheet doesn't initially have any value in
' Base our lRow on Sheet2, we don't care how many rows in Sheet1.
lrow = tb2.Cells(tb2.Rows.Count, 1).End(xlUp).Row
Dim cl as Range
Set cl = tb.Cells(2,1) 'Our initial cell value / ID
For x = 2 to lRow '## Look the rows on Sheet 2
'## Check if the cell on Sheet1 == cell on Sheet2
While cl.Value = tb2.Cells(x,1).Value
'## Add cl.Value t- the tb2 cell:
tb2.Cells(x, 2).Value = tb2.Cells(x, 2).Value + cl.Offset(0,1).Value
Set cl = cl.Offset(1) '## Reassign to the next Row
Wend
Next
But it would be better to omit the double-loop and simply use VBA to do 1 of the following:
1. Insert The Formula:
(See Scott Holtzman's answer).
This approach is better for lots of reasons, not the least of which is that the WorksheetFunction is optimized already, so it should arguably perform better though on a small dataset the difference in runtime will be negligible. The other reason is that it's stupid to reinvent the wheel unless you have a very good justification for doing so, so in this case, why write your own version of code that accomplishes what the built-in SumIf already does and is specifically designed to do?
This approach is also ideal if the reference data may change, as the cell formulas will automatically recalculate based on the data in Sheet1.
2. Evaluate the formula & replace with values only:
If you prefer not to retain the formula, then a simple Value assignment can remove the formula but retain the results:
With .Range(.Range("B2"), .Range("A2").End(xlDown).Offset(, 1))
.FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)"
.Value = .Value 'This line gets rid of the formula but retains the values
End With
Use this approach if you will be removing Sheet1, as removing the referents will break the formula on Sheet2, or if you otherwise want the Sheet2 to be a "snapshot" instead of a dynamic summation.
If you really need this automated, take advantage of VBA to place the formula for you. It's very quick and easy using R1C1 notation.
Complete code (tested):
Dim tb As Worksheet
Dim tb2 As Worksheet
Set tb = Sheets("sheet1")
Set tb2 = Sheets("sheet2")
Dim lrow As Long
lrow = tb.Cells(tb.Rows.Count, 1).End(xlUp).Row
tb.Range("A2:A" & lrow).Copy tb2.Range("A2")
With tb2
.Range("A2").CurrentRegion.RemoveDuplicates 1
With .Range(.Range("B2"), .Range("A2").End(xlDown).Offset(, 1))
.FormulaR1C1 = "=SUMIF(Sheet1!C[-1]:C[-1],RC[-1],Sheet1!C:C)"
End With
End With
Note that with R1C1 notation the C and R are not referring to column or row letters . Rather they are the column and row offsets from the place where the formula is stored on the specific worksheet. In this case Sheet!C[-1] refers to the entire A column of sheet one, since the formula is entered into column B of sheet 2.
I wrote a neat little algorithm (if you can call it that) that does what you want them spits out grouped by totals into another sheet. Basically it loops through the first section to get unique names/labels and stores them into an array. Then it iterates through that array and adds up values if the current iteration matches what the current iteration of the nested loop position.
Private Sub that()
Dim this As Variant
Dim that(9, 1) As String
Dim rowC As Long
Dim colC As Long
this = ThisWorkbook.Sheets("Sheet4").UsedRange
rowC = ThisWorkbook.Sheets("Sheet4").UsedRange.Rows.Count
colC = ThisWorkbook.Sheets("Sheet4").UsedRange.Columns.Count
Dim thisname As String
Dim i As Long
Dim y As Long
Dim x As Long
For i = LBound(this, 1) To UBound(this, 1)
thisname = this(i, 1)
For x = LBound(that, 1) To UBound(that, 1)
If thisname = that(x, 0) Then
Exit For
ElseIf thisname <> that(x, 0) And that(x, 0) = vbNullString Then
that(x, 0) = thisname
Exit For
End If
Next x
Next i
For i = LBound(that, 1) To UBound(that, 1)
thisname = that(i, 0)
For j = LBound(this, 1) To UBound(this, 1)
If this(j, 1) = thisname Then
thisvalue = thisvalue + this(j, 2)
End If
Next j
that(i, 1) = thisvalue
thisvalue = 0
Next i
ThisWorkbook.Sheets("sheet5").Range(ThisWorkbook.Sheets("Sheet5").Cells(1, 1), ThisWorkbook.Sheets("Sheet5").Cells(rowC, colC)).Value2 = that
End Sub
Yay arrays
So, I'm a bit baffled on how to move forward, and would like some collaboration to get me started. I'm not asking for someone to code this, but to verify my theoretical path forward.
Background:
I have a single worksheet with 30 activities. Each activity is 75 rows, with the first of the 75 rows having a cell with the description of the activity. Assuming the # of columns is irrelevent to this, the activities A, B, and C, would appear such as:
A1
A...
A75
B1
B...
B75
C1
C...
C75
Theoretical path forward:
Since I have a known row which starts each activity, I was thinking that I could:
.1) Copy the known cell from each row that I intend to sort by to another sheet (this isn't preferred, but is how I can think to do it).
.2) Once in the other sheet, Sort the activity descriptions.
.3) Once sorted, I want to copy each of the activities 75 rows, in order, to the sorted sheet, via Match or Find.
.4) Once completed, I would Copy the Activities from the new sheet, paste back into the original sheet, then delete the new sheet.
Question:
Does this sound appropriate? Is there possibly a better way to do this that immediately comes to mind?
I think you could save a lot of time copying and pasting if you used a 2 dimensional array. This program stops at each 75th row and loads up the 2d array "Activities" from column A. The array gets passed to bubblesort where it is sorted on the first value. Then it is returned and all output to column B. You might have to adjust the constants to match and if there is a blank row between activities there will be some other minor adjustments to the two main loops.
Option Compare Text
Const RowsPerActivity As Integer = 75 'setting
Const NumActivities As Integer = 30 'setting
Const RowtoSortOn As Integer = 1 'setting
Sub SortGroups()
Dim MySheet As Worksheet
Set MySheet = Worksheets("sheet1")
Dim Activities(1 To NumActivities, 1 To RowsPerActivity) As Variant
Dim CurActivity, CurDataRow As Integer
Dim LastRow As Integer
LastRow = MySheet.Cells(MySheet.Rows.Count, "A").End(xlUp).Row
For CurActivity = 1 To LastRow Step RowsPerActivity 'maybe +1 if there is a blank row between activities
For CurDataRow = 1 To RowsPerActivity Step 1
Activities((CurActivity \ 75) + 1, CurDataRow) = MySheet.Cells(CurActivity + CurDataRow - 1, 1).Value
Next CurDataRow
Next CurActivity
Call BubbleSort(Activities)
For CurActivity = 1 To LastRow Step RowsPerActivity 'maybe +1 if there is a blank row between activities
For CurDataRow = 1 To RowsPerActivity Step 1
MySheet.Cells(CurActivity + CurDataRow - 1, 2).Value = Activities((CurActivity \ 75) + 1, CurDataRow)
Next CurDataRow
Next CurActivity
End Sub
Sub BubbleSort(ByRef list() As Variant)
' Sorts an array using bubble sort algorithm
Dim First As Integer, Last As Long
Dim i As Long, j As Long, k As Long
Dim Temp As Variant
First = LBound(list, 1)
Last = UBound(list, 1)
For i = First To Last - 1
For j = i + 1 To Last
If list(i, RowtoSortOn) > list(j, RowtoSortOn) Then
For k = 1 To RowsPerActivity
Temp = list(j, k)
list(j, k) = list(i, k)
list(i, k) = Temp
Next k
End If
Next j
Next i
End Sub
I have data that I am working to Parse Out that I have imported from approval emails sent in Outlook. At this point I am just importing the CreationTime and the SubjectLine.
For the subject line I am able to use the Split function to separate out most of the data. I then am left with Job Codes in Column B and Position numbers in Column C which includes the text: "Job Codes: XXXX" and the four digit job code number and "PN XXXX" and either a four digit or 6 digit position number. I am trying to use the Right functionality to loop through the entire column and reformat the column just to show only the four digit job code number for Column B and either just the 4 digit or 6 digit position number (the actual numbers) for Column C
For Job Code Column B:
Currently my code works for Shortening the Job Codes but it involves adding a column, putting the RIGHT formula in that column for the shortened Job Code, then copying and pasting the formula as values back into the column and then deleting the original column.
The problem- Works but perhaps not the most efficient with a larger data set (currently 200 rows but will have 2000 or more)
Code:
Sub ShortenJobCodes()
Application.ScreenUpdating = False
Const R4Col = "=RIGHT(RC3,4)"
Dim oRng As Range
Dim LastRow As Long
Range("B1").EntireColumn.Insert
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set oRng = Range("B:B")
Range(oRng, Cells(LastRow, "B")).FormulaR1C1 = R4Col
Set oRng = Nothing
Columns("B").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("C1").EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
For Position Numbers Column C:
Currently I have mirrored the above code but added in an if statement using LEN to count if the characters are less than 8, if so then insert one RIGHT function if not insert the other RIGHT function. This also involves adding an additional column putting the RIGHT formula in that column for the shortened Position Number(Eliminating all but just the number), then copying and pasting the formula as values back into the column and then deleting the original column.
Problem - This works but seems to take forever to process and in fact looks like it is in an infinite loop. When I Esc out of it, it does add the column and then input the proper RIGHT formula (leaving just the numeric values) but the sub never seems to end, nor does it copy and paste the formulas as values or delete the original column. As noted above I realize this is likely a more efficient way to do this but I have tried a bunch of options without any luck.
I am realizing part of the loop might be due to the range itself being an entire column but I cannot find a way to stop that with the last row (even though I have a count in there).
Code:
Sub ShortenPositionNumbers()
Application.ScreenUpdating = False
Const R4Col = "=RIGHT(RC4,4)"
Const R6Col = "=RIGHT(RC4,6)"
Dim oRng As Range
Dim rVal As String
Dim y As Integer
Dim selCol As Range
Dim LastRow As Long
Range("C1").EntireColumn.Insert
LastRow = Cells(Rows.Count, "A").End(xlUp).Row
Set selCol = Range("D:D")
For Each oRng In selCol
oRng.Select
rVal = oRng.Value
If Len(oRng.Value) > 8 Then
oRng.Offset(0, -1).FormulaR1C1 = R6Col
Else
oRng.Offset(0, -1).FormulaR1C1 = R4Col
End If
Next
Set oRng = Nothing
Columns("C").Select
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues
Range("D1").EntireColumn.Delete
Application.ScreenUpdating = True
End Sub
Major Question: Is there a way to use RIGHT/TRIM/LEN/LEFT functions to do this within a cell without having to add columns/delete columns and insert functions?
There are a few things you can do here to speed up your code. I'm only going to reference the second code block as you can apply similar logic to the first.
The first issue is that you create a LastRow variable but never reference it again. It looks like you meant to use this in the selCol range. You should change that line to Set selCol = Range("C1:C" & lastRow). This way, when you loop through the rows you only loop through the used rows.
Next, in the For-Each loop you Select every cell you loop through. There really isn't any reason to do this and takes substantially longer. You then create the variable rVal but never use it again. A better way to set up the loop is as follows.
For Each oRng in selCol
rVal = oRng.Value
If Len(rVal) > 8 Then
oRng.Value = Right(rVal, 6)
Else
oRng.Value = Right(rVal, 4)
End If
Next
This is much cleaner and no longer requires creating columns or copying and pasting.
Try this, it uses Evaluate and no loops or added columns.
Sub ShortenPositionNumbers()
Application.ScreenUpdating = False
Dim selCol As Range
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(Rows.Count, "A").End(xlUp).Row
Set selCol = .Range(.Cells(1, 3), .Cells(LastRow, 3))
selCol.Value = .Evaluate("INDEX(IF(LEN(" & selCol.Address(0, 0) & ")>8,RIGHT(" & selCol.Address(0, 0) & ",6),RIGHT(" & selCol.Address(0, 0) & ",4)),)")
End With
Application.ScreenUpdating = True
End Sub
Or work with arrays
Sub ShortenPositionNumbers()
Dim data As Variant
Dim i As Long
With Range("C3:C" & Cells(Rows.Count, "A").End(xlUp).Row)
data = Application.Transpose(.Value)
For i = LBound(data) to UBound(data)
If Len(data(i)) > 8 Then
data(i) = RIGHT(data(i),6)
Else
data(i) = RIGHT(data(i),4)
End If
Next
.Value = Application.Transpose(data)
End With
End Sub
I've found a couple threads with similar titles but weren't really what I am looking to do. What I'm trying to do is go through the list of numbers in Col A, and calculate the time difference using NetworkDays for the first instance the number appears in Col B ' Received On ' and the last instance the number appears in Col C ' Processed On '. After the NetworkDays calculation is done I'd like to put that value repeating in Col D on every respective row. The number of times a value will appear in Col A constantly varies, and Col A itself is several thousand lines long and constantly growing. Once that is done I need to loop through all the other different sets of numbers in Col A and repeat the process. As an example, ***39430 first appears on Row 2 and last appears on Row 7. Using Networkdays(B2,C7) gives 11 days, and so forth. After that move onto ***39383. Sample below.
Sample data
Below is the code I have so far. From the sample above I have to put a blank row under ***39430 in order to get the code to work, otherwise it just continues on to the bottom of the list and calculates that difference (not what I want obviously). What I'm stumped on is how to tell the loop to restart whenever the value changes in Col A and then continue on. I suspect it might be something close to Do Until ActiveCell.Value <> Activecell.Offset(-1,0).Value but I can't quite figure it out. Also how to get the Networkdays value to repeat on every respective row.
Dim counter As Integer
Dim CycleTime As Long
counter = 0
Do Until ActiveCell.Value = ""
counter = counter + 1
ActiveCell.Offset(1, 0).Select
Loop
'Gives the number of rows to offset
MsgBox counter
'Shows the correct number of days difference
MsgBox WorksheetFunction.NetworkDays(Range("B2"), Range("B2").Offset(counter - 1, 1))
CycleTime = WorksheetFunction.NetworkDays(Range("B2"), Range("B2").Offset(counter - 1, 1))
Range("D2").Value = CycleTime
Any help would be greatly appreciated. Thanks in advance.
Update
After using the code provided for a couple of weeks I've noticed a complication that I had not thought of before. Previously, I had thought that there was always only one output doc for each input doc (not considered in scope of original question), however as shown in Sample-New image in the top box there can be more than one output doc per input doc. For the new screenshot below I've included two additional columns, Col. C 'Output Doc #' and Col. D 'Output Doc Created On'. What I'd like to be able to do, amending the code that #YowE3K provided below, is to nest another loop that goes through Col. D 'Output Doc #' and uses NetworkDays to calculate the difference from B1 and D1 for the first group, and then B1 and D8 for the second group. As it is now, the code isn't written to handle the change and calculates everything as shown in Column F, with the ideal code resulting in Column G. The second box (in dark blue) shows a typical example where the code performs perfectly. Loops are something I'm struggling with to understand and not really sure how to even take a stab at this. Any comments to the code in a response would be very helpful. Thanks in advance.
Sample - New
The following code loops using endRow as the loop "counter".
startRow is set to the row containing the start of the current "Doc Number", and endRow is incremented until it is pointing at the last row for that "Doc Number".
Once endRow is pointing at the correct place, CycleTime is calculated and written to column D of each row from startRow to endRow. startRow is then set to point to the beginning of the next "Doc Number".
The loop ends when a blank cell is found in column A.
Sub Calc()
Dim startRow As Long
Dim endRow As Long
Dim CycleTime As Long
startRow = 2
endRow = 2
Do
If Cells(startRow, "A").Value <> Cells(endRow + 1, "A").Value Then
CycleTime = WorksheetFunction.NetworkDays(Cells(startRow, "B"), Cells(endRow, "C"))
Range(Cells(startRow, "D"), Cells(endRow, "D")).Value = CycleTime
startRow = endRow + 1
End If
endRow = endRow + 1
If Cells(endRow, "A").Value = "" Then
Exit Do
End If
Loop
End Sub
Edited to keep track of the first and last "Approved" record, and only update column D if one is found:
Sub Calc()
Dim startRow As Long 'Start of the Doc Number
Dim firstRow As Long 'First "approved" row
Dim lastRow As Long 'Last "approved" row
Dim endRow As Long 'End of the Doc Number
Dim CycleTime As Long
startRow = 2
endRow = 2
firstRow = -1
lastRow = -1
Do
If Cells(endRow, "Q").Value = "Approved" Then
'Found an "Approved" record
'Set the first row if not already set
If firstRow = -1 Then
firstRow = endRow
End If
'Set the last row (will replace this if we find another record)
lastRow = endRow
End If
If Cells(startRow, "A").Value <> Cells(endRow + 1, "A").Value Then
If firstRow > 0 Then ' (If it is -1 then we never found an "Approved" record)
CycleTime = WorksheetFunction.NetworkDays(Cells(firstRow, "B"), Cells(lastRow, "C"))
Range(Cells(startRow, "D"), Cells(endRow, "D")).Value = CycleTime
End If
'Set up for next Doc Number
startRow = endRow + 1
firstRow = -1
lastRow = -1
End If
'Go to next row
endRow = endRow + 1
'Exit when we hit a blank Doc Number
If Cells(currentRow, "A").Value = "" Then
Exit Do
End If
Loop
End Sub