Skip to content

Instantly share code, notes, and snippets.

@Amm1rr
Created November 16, 2021 16:36
Show Gist options
  • Save Amm1rr/d27beeafa6a67888065ff5628fe106d4 to your computer and use it in GitHub Desktop.
Save Amm1rr/d27beeafa6a67888065ff5628fe106d4 to your computer and use it in GitHub Desktop.
Search in a tables on a excel file and replace and combine with other table.
Public Sub Worksheet_Replace()
Dim rplce As String
Dim searchfor As String
If Lic <> True Then End
searchfor = InputBox("Search For :", "Search for What", "tesco")
If Len(Trim(searchfor)) <= 0 Then
End
End If
For i = 1 To Range("Keywords").Rows.Count
rplce = Range("C2")(i)
1
For ii = 1 To Range("Search").Rows.Count
Dim searchin As String
searchin = Range("Search")(ii)
Dim newval(0)
newval(0) = Replace(searchin, searchfor, rplce)
AddDataRow "Results", newval
'MsgBox searchfor + " - " + rplce
'Range("Search")(ii).Replace what:=searchfor, Replacement:=rplce, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
MatchCase:=False, _
SearchFormat:=False, _
ReplaceFormat:=False
Next ii
Next i
Dim l As Integer
l = Range("Results").Rows.Count
MsgBox "Done !," + vbCrLf + vbCrLf & l & " New Keywords added succeccfully.", vbOKOnly + vbInformation, "by Soheyl"
End Sub
Sub AddDataRow(tableName As String, values() As Variant)
Dim sheet As Worksheet
Dim table As ListObject
Dim col As Integer
Dim lastRow As Range
Set sheet = ActiveWorkbook.Worksheets("Sheet1")
Set table = sheet.ListObjects.Item(tableName)
'First check if the last row is empty; if not, add a row
If table.ListRows.Count > 0 Then
Set lastRow = table.ListRows(table.ListRows.Count).Range
For col = 1 To lastRow.Columns.Count
If Trim(CStr(lastRow.Cells(1, col).Value)) <> "" Then
table.ListRows.Add
Exit For
End If
Next col
Else
table.ListRows.Add
End If
'Iterate through the last row and populate it with the entries from values()
Set lastRow = table.ListRows(table.ListRows.Count).Range
For col = 1 To lastRow.Columns.Count
If col <= UBound(values) + 1 Then lastRow.Cells(1, col) = values(col - 1)
Next col
End Sub
Private Function Lic() As Boolean
Dim y As String
Lic = False
y = Format(Date, "yy")
If y = 21 Then
Lic = True
ElseIf y = 22 Then
m = Format(Date, "mm")
If m <= 6 Then
Lic = True
Else
Lic = False
End If
End If
End Function
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment