VBA find first and last row with specific value

[Barry.Burke]

Hello

I am running a macro that takes a weeks worth of noise level data and pastes them into other spreadsheets to then array specific periods of time.

The code I am running is clunky and takes a long time to run because I have been searching each row, then copy and paste into the new spreadsheet and repeat 3 more times.

What I want to do is sort the results sheet ("Logger Results") in ascending order, then copy and paste (To Sheets("615-7am")) a chunk of rows as opposed to a single row.

Basically I am having trouble with finding the first 6:15:00 and the last 7:00:00 in the list. The sheet has been sorted in ascending order from 12am.

Any help would be appreciated

Thanks

Barry

 

[p45cal]

Show us your existing code and we should be able to tweak.

 

[Barry.Burke]

Thanks

Sub Convertdata()
Dim x As Integer
Dim LastRow As Integer
Dim CopyFirst As Long
Dim CopyLast As Long
Sheets("615am-7am").Cells.Clear
Sheets("715am-6pm").Cells.Clear
Sheets("615pm-10pm").Cells.Clear
Sheets("1015pm-6am").Cells.Clear
x = 1
'Sort Logger Results sheet by ascending time
LastRow = ActiveSheet.UsedRange.Row - 1 + ActiveSheet.UsedRange.Rows.Count
Range("B1").Select
ActiveWorkbook.Worksheets("Logger Results").Sort.SortFields.Clear
ActiveWorkbook.Worksheets("Logger Results").Sort.SortFields.Add Key:=Range( _
"B2:B" & LastRow), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:= _
xlSortNormal
With ActiveWorkbook.Worksheets("Logger Results").Sort
.SetRange Range("A1:P" & LastRow)
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
'615am-7am
Sheets("Logger Results").Select
Do
If (Cells(x, 2) >= "0.260416666666667" And Cells(x, 2) <= "0.29166667") Then
Cells(x, 2).EntireRow.Copy
Sheets("615am-7am").Select
Cells(65000, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Sheets("Logger Results").Select
End If
x = x + 1
Loop Until Cells(x, 2) = ""

'Copies Header
Sheets("Logger Results").Select
Range("A1", "P1").Copy
'Pastes Header in results sheet
Sheets("615am-7am").Select
Cells(1, 1).Select
ActiveSheet.Paste
'Defines last row in results sheet
LastRow = Cells.SpecialCells(xlCellTypeLastCell).Row
'Inserts Fomula
Cells(1, 1).Select
ActiveCell.EntireRow.Insert
Range("A1").Value = "Log Average"
Range("C1").FormulaArray = "=10*LOG(AVERAGE(10^(C3:C" & LastRow & "/10)))"
Range("D1").FormulaArray = "=10*LOG(AVERAGE(10^(D3:D" & LastRow & "/10)))"
Range("K1").FormulaArray = "=10*LOG(AVERAGE(10^(K3:K" & LastRow & "/10)))"

 

[p45cal]

Try the following which gave the same results as your macro but without sorting or inserting rows:

Sub Convertdata2()
Dim LastRow As Long
Set LoggerSheet = Sheets("Logger Results")
Set DestnSheet = Sheets("615am-7am")
DestnSheet.Cells.Clear
With LoggerSheet
    LastRow = .UsedRange.Row - 1 + .UsedRange.Rows.Count
    With .Range("A1:P" & LastRow)
        .AutoFilter
        .AutoFilter Field:=2, Criteria1:=">=06:15:00", Operator:=xlAnd, Criteria2:="<=07:00:00"
        .Copy DestnSheet.Range("A2")
    End With
End With
With DestnSheet
    'Defines last row in results sheet
    LastRow = .Cells.SpecialCells(xlCellTypeLastCell).Row    'not sure if this is safe since sometimes xlCellTypeLastCell is not updated properly.
    'Inserts Formulae
    .Range("A1").Value = "Log Average"
    .Range("C1").FormulaArray = "=10*LOG(AVERAGE(10^(R[2]C:R[" & LastRow & "]C/10)))"
    .Range("D1").FormulaArray = "=10*LOG(AVERAGE(10^(R[2]C:R[" & LastRow & "]C/10)))"
    .Range("K1").FormulaArray = "=10*LOG(AVERAGE(10^(R[2]C:R[" & LastRow & "]C/10)))"
End With
End Sub

 

[Barry.Burke]

That works exactly as i hoped.

Thanks alot for your help, i did not even think of using a filter.