Created
November 16, 2021 16:36
-
-
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.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
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