Looping from the limit of contents in a sheet to match and copy in VBA Excel

Question

I'm new here, and this is my problem; in vba, excel 2010 I want to search for a specific word or a list of words in every row with content in one sheet and if it matched then it copy the entire row of that sheet and paste it in a new one at the first row, and then continues looping back and foward from sheet to sheet after the list of words ends. At the end you get a new sheet with a bunch of rows collected from your search Query. I got some initial code, dont know if you guys will like to see it. Thanks.

Sub Macro1()
    Dim sheetName As String
    Dim recintos As String
    Dim recintosArray() As String
    Dim namevar As Variant
    Dim sheetLimit As Integer
    Dim n As Integer

    'Words to search and copy in the sheet 
    'Nombre del sheet a buscar en el documento abierto
    sheetName = InputBox("Nombre de la hoja o sheet en donde desea copiar los recintos :")

    'Save a string type data 
    'Guarda los datos como tipo cadena
    recintos = InputBox("Introduzca los nombres  de los recintos separados por coma :", "Buscador de recintos", "00000,00000,00000...")

    'Split the words and save it in array type 
    'Separa la cadena y los guarda en un arreglo
    recintosArray() = Split(recintos, ",")
    namevar = InputBox("Introduzca el nombre de la hoja que desea crear para pegar c/u :")

    'Makes a new sheet and defines a name
    'Crea un sheet nuevo y define el nombre
    Sheets.Add After:=Sheets(Sheets.Count)
    Sheets(Sheets.Count).Name = namevar
    sheetLimit = Sheets(sheetName).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

    'Array index
    'Indice del arreglo recintosArray
    n = 0

    For i = 1 To sheetLimit
        Sheets(sheetName).Activate
        currentCellName = Sheets(sheetName).Cells(i, 1).Value

        If n <= UBound(recintosArray) Then
            If Replace(currentCellName, Chr(32), "") = recintosArray(n) Then
                Sheets(sheetName).Rows(i).Copy
                newSheetLimit = Sheets(namevar).Cells(Rows.Count, 1).End(xlUp).Offset(0, 0).Row
                Sheets(namevar).Activate
                Sheets(namevar).Cells(newSheetLimit + 1, 1).Select
                ActiveSheet.Paste
                n = n + 1
                i = 1
            End If
        End If
    Next i
End Sub

`I got some initial code, dont know if you guys will like to see it.` -- Very much so, please post it and any errors/issues you're having. — BruceWayne, Feb 08 '20 at 02:56
How can I post it my code, it gets mixed with the body of my post. — Johan, Feb 08 '20 at 03:57
Please read https://stackoverflow.com/help/formatting and [edit] your code into your post. — Nick, Feb 08 '20 at 04:15
I want to search for an array of words, and evaluate it all, so it needs to go up in the loop at the sheet from the first row and check every indexed word, but the code can't run well and can't evaluate all the words. — Johan, Feb 08 '20 at 04:35

Ricardo Diaz · Accepted Answer · 2020-02-08T13:57:14.957

You can read the code's comments and adjust it to fit your needs

Remember to use F8 jey to step through it

There were some parts of your code that I couldn't fully understand

EDIT: Added missing function

EDIT2: Copy entire row

Code

Public Sub Macro2()

    Dim sourceSheet As Worksheet
    Dim targetSheet As Worksheet

    Dim sourceRange As Range
    Dim cell As Range

    Dim sourceSheetName As String
    Dim targetSheetName As String

    Dim recintos As String
    Dim recintosArray As Variant

    Dim lastRow As Long
    Dim targetRow As Long

    ' Set the starting row in which the cells are going to be copied
    targetRow = 1

    'Words to search and copy in the sheet
    'Nombre del sheet a buscar en el documento abierto
    sourceSheetName = InputBox("Nombre de la hoja o sheet en donde desea copiar los recintos :")
    Set sourceSheet = ThisWorkbook.Worksheets(sourceSheetName)

    'Save a string type data
    'Guarda los datos como tipo cadena
    recintos = InputBox("Introduzca los nombres  de los recintos separados por coma :", "Buscador de recintos", "00000,00000,00000...")

    'Nombre del sheet a crear
    targetSheetName = InputBox("Introduzca el nombre de la hoja que desea crear para pegar c/u :")

    'Split the words and save it in array type
    'Separa la cadena y los guarda en un arreglo
    recintosArray = Split(recintos, ",")

    ' You may want to check if user entered an array here

    ' Add a new sheet and set the reference
    Set targetSheet = ThisWorkbook.Worksheets.Add
    ' You may want to check here that the sheet doesn't exists...
    targetSheet.Name = targetSheetName

    ' Get the last row in column A
    lastRow = sourceSheet.Cells(sourceSheet.Rows.Count, 1).End(xlUp).Row

    ' Set the range where you want to look up the values
    Set sourceRange = sourceSheet.Range("A1:A" & lastRow)

    ' Loop through the column A values begining in row 1
    For Each cell In sourceRange.Cells

        ' Check if value is in array
        If IsInArray(cell.Value, recintosArray) Then
            targetSheet.Range("A" & targetRow).EntireRow.Value = cell.EntireRow.Value
            targetRow = targetRow + 1
        End If

    Next cell


End Sub

Public Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
    ' Credits: https://stackoverflow.com/a/11112305/1521579
    IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function

Let me know if it works

It works, don't have the function IsInArray, but I search and wrote it. Is it possible to match the word and then instead of copy that Cell which contains the word, copy the entire row that has in Range of cells content? — Johan, Feb 08 '20 at 13:54
@Johan Sure, see my edit2. Remember that if it works, mark the answer with the check mark at the left, so others may find it too. — Ricardo Diaz, Feb 08 '20 at 14:02
Don't worry about it, you're a master, clean and piano like code, its simple and well executed. Thanks a lot, I will read every line to learn your approach, is it any website to check this kind of stuff? just to learn more. Thanks, I will follow you until end of days. — Johan, Feb 08 '20 at 14:41
This is the site...lot of knowledge around...use [this extension](https://chrome.google.com/webstore/detail/stackeye/pihfndpmcafdecheofkjfkadecoogigm) to follow people and see how they structure their answers... — Ricardo Diaz, Feb 08 '20 at 15:12

Looping from the limit of contents in a sheet to match and copy in VBA Excel

1 Answers1