Find instances of a string in a table and using their rows

[Jimithy]

Hi,

I'm trying to have VBA count the number of instances of a string within a table, then save the table row of each instance. I then want to take these saved rows and add their data in new rows in a table elsewhere.

As an example, below are two tables (Let's call them "tblThings" and "tblNew"). tblThings includes two instances of "Thing1." My idea is that VBA finds Thing1 in rows 2 and 4 (including the header row) of the table. Then, using a For loop, a new row is added to tblNew. The data for each respective row is then added.

tblThings

Name	Data
Thing1	11
Thing2	33
Thing1	55
Thing3	77

<tbody>
</tbody>

tblNew (I should note other rows besides the new ones already existed, but are not shown here)

Name	Data
Thing1	11
Thing1	55

<tbody>
</tbody>

Sub Muffins()

Dim tblThings        As Object
Dim tblNew           As Object
Dim oNewRow          As ListRows
Dim itemName         As String
Dim itemData         As Long
Dim r                As Integer
Dim rng              As Range

Set tblThings = ActiveSheet.ListObjects("tblThings")
Set tblNew = ActiveSheet.ListObjects("tblNew")

itemName = "Thing1"

''''Create rng here

For Each r in rng
    Set oNewRow = tblNew.ListRows.Add(AlwaysInsert:=True)
    oNewRow.Range.Cells(1, 1) = itemName
    oNewRow.Range.Cells(1, 2) = itemData
Next

End Sub

I have been able to get the number of rows containing Thing1 using a CountIf line, but that isn't quite what I need. I can't seem to figure out any good way to do this. Thanks for any assistance!

 

[Roderick_E]

Will we need to look anywhere in each row or will the trigger data always be in a specific column?

 

[Jimithy]

The data will always be in the same column regardless of row. My actual data set has four data columns, but I think the behavior of each should be the same when adding them to the new table rows. I'm not able to copy entire rows due to the columns not always being adjacent, however.

e.g. row in tblThings

Thing1

Data1

Data2

not data

Data3

not data

Data4

not data

<tbody>
</tbody>

becomes in tblNew

Thing1

Data1

Data2

Formula

Data3

Data4

<tbody>
</tbody>

I hope this helps explains things well enough.

 

[Roderick_E]

Here you go. I think you can modify to your needs.

Option Compare Text 'ignore text case
Sub getuniqueentry()
Dim tblThings As Worksheet
Dim tblNew As Worksheet
Set tblThings = Worksheets("Sheet1")
Set tblNew = Worksheets("Sheet2")
On Error Resume Next
lastrow1 = 1 'incase no data
lastrow2 = 1 'incase no data
lastrow1 = tblThings.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
lastrow2 = tblNew.Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row + 1 'first blank row
Resume Next
'***set string to match***
itemName = "Thing1"
For x = 1 To lastrow1
If tblThings.Cells(x, 1) = itemName Then
tblNew.Cells(lastrow2, 1) = tblThings.Cells(x, 1)
tblNew.Cells(lastrow2, 2) = tblThings.Cells(x, 2)
lastrow2 = lastrow2 + 1
End If
Next x
MsgBox "Complete", vbInformation, "ALERT"
End Sub

Assumes destination sheet already has headers.

 

[Jimithy]

Thank you! I should be able to adapt it to my case. If I have any other trouble I'll let you know. Again, thanks for your time.