Hello,
I am using this code to compare text in activeworksheet and another Worksheet, in this case database:
code generally works, the problem is that inserts 6 rows where ever it finds text in s1. I would like to inserts rows and references from database only
where text string from s1 = s2,
thanks
I am using this code to compare text in activeworksheet and another Worksheet, in this case database:
Code:
On Error Resume Next
Dim s1 As Worksheet
Dim s2 As Worksheet
Dim i As Long
Dim j As Long
Dim Odabrano As Variant
Dim Odabrano_1 As Variant
Dim Kolona_pretrazivanje As Variant
Dim Kolon_umetanje As Variant
Dim R As Long
Kol_pret = UserForm7.TextBox1.Text
Kol_umet = UserForm7.TextBox2.Text
Kolona_pretrazivanje = Kol_pret
Kolona_umetanje = Kol_umet
Sheet_odabir = UserForm7.ListBox1.Text
Odabrano = Sheet_odabir
Sheet_odabir_1 = UserForm7.ListBox2.Text
Odabrano_1 = Sheet_odabir_1
Set s1 = ActiveWorkbook.ActiveSheet
Set s2 = Workbooks("Baza_usporedba.xlsm").Sheets(Odabrano) ' this is a database
Application.ScreenUpdating = False
'Loop sheet 1
For i = s1.Cells(Rows.Count, Kolona_pretrazivanje).End(xlUp).Row To 1 Step -1
'Loop sheet 2
For j = s2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
'For j = s2.Cells(Rows.Count, 1).End(xlUp).Row To 2 Step -1
'If match found
If InStr(1, s1.Cells(i, Kolona_pretrazivanje), s2.Cells(j, 1), vbTextCompare) >= 1 Then
s1.Cells(i + 1, Kolona_pretrazivanje).EntireRow.Insert Shift:=xlDown
s1.Cells(i + 2, Kolona_pretrazivanje).EntireRow.Insert Shift:=xlDown
s1.Cells(i + 3, Kolona_pretrazivanje).EntireRow.Insert Shift:=xlDown
s1.Cells(i + 4, Kolona_pretrazivanje).EntireRow.Insert Shift:=xlDown
s1.Cells(i + 5, Kolona_pretrazivanje).EntireRow.Insert Shift:=xlDown
s1.Cells(i + 6, Kolona_pretrazivanje).EntireRow.Insert Shift:=xlDown
s1.Cells(i, Kolona_umetanje) = s2.Cells(j, 2) ' s1.Cells(i, 4): ubacuje ref. u 1. red ispod
s1.Cells(i + 1, Kolona_umetanje) = s2.Cells(j, 3) ' s1.Cells(i, 4): ubacuje ref. u 2. red ispod
s1.Cells(i + 2, Kolona_umetanje) = s2.Cells(j, 4) ' s1.Cells(i, 4): ubacuje ref. u 3. red ispod
s1.Cells(i + 3, Kolona_umetanje) = s2.Cells(j, 5) ' s1.Cells(i, 4): ubacuje ref. u 4. red ispod
s1.Cells(i + 4, Kolona_umetanje) = s2.Cells(j, 6) ' s1.Cells(i, 4): ubacuje ref. u 5. red ispod
s1.Cells(i + 5, Kolona_umetanje) = s2.Cells(j, 7) ' s1.Cells(i, 4): ubacuje ref. u 6. red ispod
Exit For
End If
Next j
Next i
Application.ScreenUpdating = True
On Error GoTo 0
code generally works, the problem is that inserts 6 rows where ever it finds text in s1. I would like to inserts rows and references from database only
where text string from s1 = s2,
thanks