Follow up question to this:
VBA - Using Current Selection As Range Object
I have a sub (below) which is intended to copy the rows of data from the source sheet (Run Results) to the target sheet (Failed) based on the there being values in column F (Header name is Failure Type). The idea is that if column F contains any values found in my array myFType, then the entire row should be copied to the target sheet.
So, I can get this to work if I specify the Column explicitly (Column F) but I am trying not to do this and instead I use my function to locate the header then identify the range up to the last row of data and then make use of the range.
And this brings me to my query - How can I rewrite a line of this: Range("E3:E" & lngLastRow & i) to this: Range(find_Header("Failure Type", "Copy") & i) or even this Range(find_Header("Failure Type", "Copy"))
Because as it is, I am returning a range (or so I think) from my function, but from what I can tell it's not correct.
Writing out the line like this: Range(find_Header("Failure Type", "Copy") & i) gives me an error, but writing it like this: Range(find_Header("Failure Type", "Copy").Address & i) does not.
BUT, when I look at the "range" it shows me a ridiculous range of like +-8000 rows, and I only have 85 rows of data.. So this makes me think it's not working correctly. The catch is, if I select the range found, it selects the correct amount of rows (85).
This whole working with ranges is REALLY confusing me and all I am trying to achieve is copy a row by finding the header and based on the values in the column under that header.
In the Sub below, I have commented two sections where I need to "make use" of the range I return from my function.
Here is the sub:
Sub Copy()
Dim xRg As Range
Dim xCell As Range
Dim i As Long, J As Long, K As Long, x As Long, count As Long
Dim y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Dim element As Variant, myFType As Variant, myEnv As Variant, myDefects As Variant
myFType = Array("F1", "F2", "F3")
myEnv = Array("Env1", "Env2")
myDefects = Array("New", "Existing")
Set y = Workbooks("Template.xlsm")
Set ws1 = y.Sheets("Run Results")
Set ws2 = y.Sheets("Failed")
i = Worksheets("Run Results").UsedRange.Rows.count
J = Worksheets("Failed").UsedRange.Rows.count
count = 3
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Failed").UsedRange) = 0 Then J = 0
End If
lngLastRow = Cells(Rows.count, "B").End(xlUp).Row
'************
'This is where I would like to call the function to get the range
'I want to change the line from:
'Range("E3:E" & lngLastRow & i) --> Range(find_Header("Failure Type", "Copy") & i)
'************
Set xRg = Worksheets("Run Results").Range("E3:E" & lngLastRow & i)
'On Error Resume Next
Application.ScreenUpdating = False
For Each element In myFType
For K = 1 To xRg.count
If CStr(xRg(K).Value) = element Then
myLRow = ws2.Cells(Rows.count, "B").End(xlUp).Row + 1
xRg(K).EntireRow.Copy Destination:=ws2.Range("A" & myLRow)
J = J + 1
End If
Next
ws2.Activate
With ws2
'************
'This is where I would like to call the function to get the range
'I want to change the line from:
'Range("E" & Rows.count) --> Range(find_Header("Failure Type", "Copy") & Rows.count)
'AND
'Range("E3:E" & x) --> Range(find_Header("Failure Type", "Copy") & x)
'************
x = Range("E" & Rows.count).End(xlUp).Row
Range("K" & count) = Application.WorksheetFunction.CountIf(Range("E3:E" & x), element)
count = count + 1
End With
Next element
count = 8
count = 12
ws2.Columns("B:K").AutoFit
Application.ScreenUpdating = True
End Sub
Here is the function:
Function find_Header(header As String, fType As String) As Range
Dim aCell As Range, rng As Range
Dim col As Long, lRow As Long
Dim colName As String
Dim y As Workbook
Dim ws1 As Worksheet, ws2 As Worksheet
Set y = Workbooks("Template.xlsm")
Set ws1 = y.Sheets("Run Results")
Set ws2 = y.Sheets("Failed")
With ws1
Set aCell = .Range("B2:J2").Find(What:=header, LookIn:=xlValues, LookAt:=xlWhole, MatchCase:=False, SearchFormat:=False)
'If Found
If Not aCell Is Nothing Then
col = aCell.Column
colName = Split(.Cells(, col).Address, "$")(1)
lRow = Range(colName & .Rows.count).End(xlUp).Row + 1
Set myCol = Range(colName & "2")
Select Case fType
Case "Copy"
'This is your range
Set find_Header = Range(myCol.Address & ":" & colName & lRow).Offset(1, 0)
End Select
'If not found
Else
MsgBox "Column Not Found"
End If
End With
End Function
