PDA

View Full Version : [SOLVED] VBA Help please - Find First Row of Data?



plasteredric
02-21-2018, 09:43 AM
Afternoon, I have the below code in my workbook.
As it is, the data to be analysed starts on row 416 which I have input manually into the code.
Is there a way that it can find the first row of data? Maybe with a helper cell containing '***X' in the row above?



Sub GET_RTR_RESULTS()


Application.Calculation = xlCalculationManual


Dim outarr() As Variant ' this defines an array of variants.
' so that it can write it back to the worksheet


If ActiveSheet.Range("BLANK_RESULTS_DATA_CHECK").Value <> "BLANK" Then
' this checks to confirm there is no results data within the current sheet
MsgBox "Sheet Already Contains Data - Consider Clearing Sheet First", 0, "Validity Check Error"

Exit Sub

End If

If UCase(Sheets("RTR_IMPORT").Range("RTR_HEADER_CHECKBOX")) <> "TRUE" Then
' this checks that RTR_Import sheet headers match the headers from the RTR raw data
MsgBox "Sheet 'RTR_Import' headers do not match", 0, "RTR Check Error"

Exit Sub

End If

With Sheets("RTR_Import") ' the following code is exececuted on the RTR_Import sheet
lastrow = .Cells(Rows.Count, "K").End(xlUp).Row ' this finds the last cell with data in it on column "K" (Horse Names)
Import = Range(.Cells(1, 1), .Cells(lastrow, 24)) ' this copies all of the data (column 1 to column 24 [Columns A to X])
' from the RTR_Import sheet to the virtual array "Import"

End With ' the code "with" RTR_Import sheet ends here

With ActiveSheet ' do everything on the active sheet from here on
lastnam = .Cells(Rows.Count, "G").End(xlUp).Row ' This finds the last cell with data in it in column G on active sheet
Namearr = Range(.Cells(1, 1), .Cells(lastnam, 7)) ' This loads all data in columns 1 to 7 (A to G) from active sheet into the virtual array "Namearr"

ReDim outarr(1 To lastnam - 415, 1 To 6) ' this redimensions the output array to the correct size

For i = 416 To lastnam ' this controls the loop through all the names in the virtual array "Namearr" (column 7 [G] of active sheet)
For j = 6 To lastrow ' this controls the loop through the data in the virtual array "Import" (from RTR_Import sheet)

If Namearr(i, 7) = Import(j, 11) And Namearr(i, 3) = Import(j, 7) Then ' this compares the data in "Namearr" to the "Import" Array
' if a match to both is found, then data is copied as follows to the separate virtual output arrays

outarr(i - 415, 1) = Import(j, 18) ' copy data from column 18 (R) of RTR_Import sheet to output array on the same line as the Active sheet
outarr(i - 415, 2) = Import(j, 19) ' copy data from column 19 (S) of RTR_Import sheet to output array on the same line as the Active sheet
outarr(i - 415, 3) = Import(j, 20) ' copy data from column 20 (T) of RTR_Import sheet to output array on the same line as the Active sheet
outarr(i - 415, 4) = Import(j, 21) ' copy data from column 21 (U) of RTR_Import sheet to output array on the same line as the Active sheet
outarr(i - 415, 5) = Import(j, 22) ' copy data from column 22 (V) of RTR_Import sheet to output array on the same line as the Active sheet
outarr(i - 415, 6) = Import(j, 23) ' copy data from column 23 (W) of RTR_Import sheet to output array on the same line as the Active sheet

Exit For
End If
Next j
Next i

Range(.Cells(416, 19), .Cells(lastnam, 24)) = outarr ' write the output data (columns 18 to 23) from RTR_Import sheet to columns 19 (S) To 24 (X) on the Active sheet

End With

Application.Calculation = xlCalculationAutomatic

End Sub

SamT
02-21-2018, 01:18 PM
With ActiveSheet
FirstDataRow = .Range("A:A").Find("***X).Row + 1
FirstCellOfData = .Range("A:A").Find("***X).Offset(1,0)

With validity testing

Dim Found As Range
With ActiveSheet
Set Found = .Range("A:A").Find("***X)
If Found Is Nothing Then Exit Sub, MsgBox, whatever
FirstDataRow = Found.Row + 1
FirstCellOfData = Found.Offset(1,0)

plasteredric
02-22-2018, 09:25 AM
Thank you for your reply

I have tried to incorporate your code however im unable to figure out where it needs to go in my code.



With ActiveSheet
FirstDataRow = .Range("A:A").Find("***X).Row + 1
FirstCellOfData = .Range("A:A").Find("***X).Offset(1,0)

With validity testing

Dim Found As Range
With ActiveSheet
Set Found = .Range("A:A").Find("***X)
If Found Is Nothing Then Exit Sub, MsgBox, whatever
FirstDataRow = Found.Row + 1
FirstCellOfData = Found.Offset(1,0)

plasteredric
02-23-2018, 08:45 AM
Figured it out, used the code like this


Sub GET_RTR_RESULTS()


Application.Calculation = xlCalculationManual


Dim Found As Range
Dim outarr() As Variant ' this defines an array of variants.
' so that it can write it back to the worksheet

' other code....



With ActiveSheet
Set Found = .Range("A:A").Find("***X", lookat:=xlWhole)


If Found Is Nothing Then
MsgBox "Reference Cell Not Found", 0, "Check Error"

Exit Sub

End If

FirstDataRow = Found.Row + 1
HeaderDataRow = Found.Row
FirstCellOfData = Found.Offset(1, 1)
lastnam = .Cells(Rows.Count, "G").End(xlUp).Row ' This finds the last cell with data in it in column G on active sheet
Namearr = Range(.Cells(1, 1), .Cells(lastnam, 7)) ' This loads all data in columns 1 to 7 (A to G) from active sheet into the virtual array "Namearr"

ReDim outarr(1 To lastnam - HeaderDataRow, 1 To 6) ' this redimensions the output array to the correct size

For i = FirstDataRow To lastnam ' this controls the loop through all the names in the virtual array "Namearr" (column 7 [G] of active sheet)
For j = 6 To lastrow ' this controls the loop through the data in the virtual array "Import" (from RTR_Import sheet)

If Namearr(i, 7) = Import(j, 11) And Namearr(i, 3) = Import(j, 7) Then ' this compares the data in "Namearr" to the "Import" Array
' if a match to both is found, then data is copied as follows to the separate virtual output arrays

outarr(i - HeaderDataRow, 1) = Import(j, 18) ' copy data from column 18 (R) of RTR_Import sheet to output array on the same line as the Active sheet
outarr(i - HeaderDataRow, 2) = Import(j, 19) ' copy data from column 19 (S) of RTR_Import sheet to output array on the same line as the Active sheet
outarr(i - HeaderDataRow, 3) = Import(j, 20) ' copy data from column 20 (T) of RTR_Import sheet to output array on the same line as the Active sheet
outarr(i - HeaderDataRow, 4) = Import(j, 21) ' copy data from column 21 (U) of RTR_Import sheet to output array on the same line as the Active sheet
outarr(i - HeaderDataRow, 5) = Import(j, 22) ' copy data from column 22 (V) of RTR_Import sheet to output array on the same line as the Active sheet
outarr(i - HeaderDataRow, 6) = Import(j, 23) ' copy data from column 23 (W) of RTR_Import sheet to output array on the same line as the Active sheet

Exit For
End If
Next j
Next i

Range(.Cells(FirstDataRow, 19), .Cells(lastnam, 24)) = outarr ' write the output data (columns 18 to 23) from RTR_Import sheet to columns 19 (S) To 24 (X) on the Active sheet

End With

Application.Calculation = xlCalculationAutomatic

End Sub




Thank you for your reply

I have tried to incorporate your code however im unable to figure out where it needs to go in my code.

SamT
02-23-2018, 11:54 AM
Thank you for sharing the solution with everybody.

I knew you could do it. :hi: