Instr question

Progr01

New Member
Joined
Jul 18, 2017
Messages
9
Hello,

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
 

Excel Facts

Shade all formula cells
To shade all formula cells: Home, Find & Select, Formulas to select all formulas. Then apply a light fill color.

Forum statistics

Threads
1,213,528
Messages
6,114,154
Members
448,553
Latest member
slaytonpa

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top