VBE Data Extraction Header!

[FGaxha]

Hi,

I have a Macro code as bellow, to search for few criteria's and extract data to new tab. I need help to copy the Header from Column A1 to V1 on every tab when I run the macro.
Thank you.

Sub TestTim()
test3 "OES", "Tim"
End Sub

Sub TestGeorge()
test3 "OES", "George"
End Sub

Sub test3(Category As String, FirstName As String)
Dim outarr()
Dim inarr As Variant, indi As Long, I As Long, J As Long '<<<< missing variable declarations.

inarr = Range("A1:V7500").Value
ReDim outarr(1 To 7500, 1 To 22)
indi = 1
For I = 2 To 7500
If UCase(inarr(I, 10)) = UCase(Category) And UCase(inarr(I, 20)) = UCase(FirstName) And inarr(I, 22) <= 12 Then
' copy row
For J = 1 To 22
outarr(indi, J) = inarr(I, J)
Next J
indi = indi + 1
End If
Next I
Worksheets.Add
ActiveSheet.Name = FirstName
If indi > 1 Then
Range(Cells(1, 1), Cells(indi - 1, 22)) = outarr
End If
End Sub

 

[DanteAmor]

Hi @FGaxha , thanks for posting on MrExcel.

Try this:

Sub TestTim()
  test3 "OES", "Tim"
End Sub

Sub TestGeorge()
  test3 "OES", "George"
End Sub

Sub test3(Category As String, FirstName As String)
  Dim sh As Worksheet
  Dim outarr()
  Dim inarr As Variant
  Dim indi As Long, i As Long, j As Long, lr As Long
  
  Set sh = ActiveSheet
  lr = sh.Range("A:V").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  inarr = sh.Range("A1:V" & lr).Value
  ReDim outarr(1 To UBound(inarr, 1), 1 To 22)
  indi = 0
  
  For i = 1 To UBound(inarr, 1)
    If UCase(inarr(i, 10)) = UCase(Category) And _
       UCase(inarr(i, 20)) = UCase(FirstName) And _
       inarr(i, 22) <= 12 Then
      ' copy row
      indi = indi + 1
      For j = 1 To 22
        outarr(indi, j) = inarr(i, j)
      Next j
    End If
  Next i
  
  If indi > 0 Then
    Worksheets.Add(, Sheets(Sheets.Count)).Name = FirstName
    sh.Rows(1).Copy Rows(1)
    Range("A2").Resize(indi, UBound(outarr, 2)) = outarr
  End If
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

 

[FGaxha]

Hi @FGaxha , thanks for posting on MrExcel.

Try this:

Sub TestTim()
  test3 "OES", "Tim"
End Sub

Sub TestGeorge()
  test3 "OES", "George"
End Sub

Sub test3(Category As String, FirstName As String)
  Dim sh As Worksheet
  Dim outarr()
  Dim inarr As Variant
  Dim indi As Long, i As Long, j As Long, lr As Long
 
  Set sh = ActiveSheet
  lr = sh.Range("A:V").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  inarr = sh.Range("A1:V" & lr).Value
  ReDim outarr(1 To UBound(inarr, 1), 1 To 22)
  indi = 0
 
  For i = 1 To UBound(inarr, 1)
    If UCase(inarr(i, 10)) = UCase(Category) And _
       UCase(inarr(i, 20)) = UCase(FirstName) And _
       inarr(i, 22) <= 12 Then
      ' copy row
      indi = indi + 1
      For j = 1 To 22
        outarr(indi, j) = inarr(i, j)
      Next j
    End If
  Next i
 
  If indi > 0 Then
    Worksheets.Add(, Sheets(Sheets.Count)).Name = FirstName
    sh.Rows(1).Copy Rows(1)
    Range("A2").Resize(indi, UBound(outarr, 2)) = outarr
  End If
End Sub

--------------
Let me know the result and I'll get back to you as soon as I can.
Sincerely
Dante Amor
--------------

Thank you Sir,
One more query:
For Both Macros I would like to search "OE","Tim" and rename New Tab Tim_OE.
If I Modify as bellow do you think it will work??

Sub TestTim()
  test3 "OES", "Tim"
   test3 "OE", "Tim_OE"
End Sub

Sub TestGeorge()
  test3 "OES", "George"
   test3 "OE", "George_OE"
End Sub

 

[DanteAmor]

For Both Macros I would like to search "OE","Tim" and rename New Tab Tim_OE.

I don't understand what you need.

Do you want 2 sheets with the same data but with 2 different names?
What is the end goal?

It's a new topic, it seems to me that this has nothing to do with the original post: "I need help to copy the Header from Column A1 to V1 on every tab"

 

[FGaxha]

I don't understand what you need.

Do you want 2 sheets with the same data but with 2 different names?
What is the end goal?

It's a new topic, it seems to me that this has nothing to do with the original post: "I need help to copy the Header from Column A1 to V1 on every tab"

Sorry for the confusion:
So,
in Column 10 I have "OE" and "OES" but Column 20 I have "Tim" and "George" in the master data sheet,.
So with existing Marco it filter any row that contains "OES" and "Tim" and paste on new Tab named "Tim".
I want the second marco that filter all rows containing "OE" and "Tim" and create new Tab named "Tim_OE"

Hope this time is clear query

 

[DanteAmor]

I suggest you create 4 sheets:
Tim-OES
Tim-OE
George-OES
George-OE

Adjust in this line the name of your sheet with data:

Set sh = Sheets("Sheet9")   'Fit to the name of your sheet with data.

Then try:

Sub TestTim()
  test3 "OES", "Tim"
  test3 "OE", "Tim"
End Sub

Sub TestGeorge()
  test3 "OE", "George"
  test3 "OES", "George"
End Sub

Sub test3(Category As String, FirstName As String)
  Dim sh As Worksheet
  Dim outarr()
  Dim inarr As Variant
  Dim indi As Long, i As Long, j As Long, lr As Long
 
  Set sh = Sheets("Sheet9")   'Fit to the name of your sheet with data.
  lr = sh.Range("A:V").Find("*", , xlValues, xlPart, xlByRows, xlPrevious).Row
  inarr = sh.Range("A1:V" & lr).Value
  ReDim outarr(1 To UBound(inarr, 1), 1 To 22)
  indi = 0
 
  For i = 1 To UBound(inarr, 1)
    If UCase(inarr(i, 10)) = UCase(Category) And _
       UCase(inarr(i, 20)) = UCase(FirstName) And _
       inarr(i, 22) <= 12 Then
      ' copy row
      indi = indi + 1
      For j = 1 To 22
        outarr(indi, j) = inarr(i, j)
      Next j
    End If
  Next i
 
  If indi > 0 Then
    Worksheets.Add(, Sheets(Sheets.Count)).Name = FirstName & "-" & Category
    sh.Rows(1).Copy Rows(1)
    Range("A2").Resize(indi, UBound(outarr, 2)) = outarr
  End If
End Sub

 

[FGaxha]

Thank you Sir. You are such a great master.