Results 1 to 2 of 2

Thread: Problem with line (row) in a macro

  1. #1
    Member
    Join Date
    Nov 2012
    Posts
    47
    Rep Power
    0

    Problem with line (row) in a macro

    Hello friends, I wrote in two forums but second week no one can help me with my problem and just one line in the macro. There is something that needs to change for things to happen but I do not know what and how to change it. I would be very grateful if you assist me by your side.

    Thanks to colleague (who helped me a lot and I am grateful to him) make a macro that I do a great job, but I have a problem I can not handle.
    With this macro search from a database of all matching words and returns the result in the selected column and adds matches with plus sign (+) -> word1+word2+word3.......... or result = ?
    But there's a problem, because if the words are too similar macro I added each match and shows wrong result.
    QUIN200 -> RESULT=10, QUIN200PR -> result=15
    sim20 -> RESULT=8, sim10 -> result=5
    If I'm looking for word such as: (QUIN200) and (SIM20)
    And in the database have close similar words
    QUIN200
    QUIN200PR
    SIM20
    SIM10
    ....
    ect
    I've selected column and the appropriate box should I return this result: 10+8
    ​But now I return a result that is wrong, because obviously evidence from macro should I order something to change: 10+15+8+5
    Code:
    Sub Terapia()  
    Dim X As Long, Cell As Range, CellText As String, ws As Worksheet 
      Dim Words As Variant, Replacements As Variant
      Const TableSheetName As String = "Sheet1"
      Application.Volatile
      Words = Sheets(TableSheetName).Range("AH2", Sheets(TableSheetName).Cells(Rows.Count, "AH").End(xlUp))
        Replacements = Sheets(TableSheetName).Range("AI2", Sheets(TableSheetName).Cells(Rows.Count, "AI").End(xlUp))
        For Each ws In Worksheets
        For Each Cell In ws.Range("J2", ws.Cells(Rows.Count, "J").End(xlUp))
        CellText = ""
          For X = 1 To UBound(Words)
            If InStr(1, Cell.Value, Words(X, 1), vbTextCompare) Then CellText = CellText & "+" & Replacements(X, 1) ' Here is my problem
          Next
          Cell.Offset(, 4).Value = Mid(CellText, 2) 
        Next
      Next
    End Sub
    Again with the assistance of a colleague changed this line in the macro:
    Code:
    If InStr(1, Cell.Value, Words(X, 1), vbTextCompare) Then CellText = CellText & "+" & Replacements(X, 1)
    with this:
    Code:
    If Cell.Value = Words(X, 1) Then CellText = CellText & "+" & Replacements(X, 1)
    but now I have another problem (with this modified line) is exactly what I'm looking for, but if a row has more than one word, I do not add the next (or the result).
    attach an image to grasp the idea:
    Link image

  2. #2
    Administrator Admin's Avatar
    Join Date
    Mar 2011
    Posts
    1,123
    Rep Power
    10
    Hi

    not sure about this...

    Code:
    Option Explicit
    
    Sub Terapia()
    
        Dim X As Long, Cell As Range, CellText As String, ws As Worksheet
        Dim Words As Variant, Replacements As Variant, k, i As Long
        
        Const TableSheetName As String = "Sheet1"
        Application.Volatile
        
        Words = Sheets(TableSheetName).Range("AH2", Sheets(TableSheetName).Cells(Rows.Count, "AH").End(xlUp))
        Replacements = Sheets(TableSheetName).Range("AI2", Sheets(TableSheetName).Cells(Rows.Count, "AI").End(xlUp))
        For Each ws In Worksheets
            For Each Cell In ws.Range("J2", ws.Cells(Rows.Count, "J").End(xlUp))
                k = Split(Cell.Value, ",") '<<<< adjust the delimiter
                CellText = ""
                For i = 0 To UBound(k)
                    For X = 1 To UBound(Words)
                        If Trim(k(i)) = Words(X, 1) Then CellText = CellText & "+" & Replacements(X, 1)
                    Next
                Next
                Cell.Offset(, 4).Value = Mid(CellText, 2)
            Next
        Next
        
    End Sub
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    http://www.eileenslounge.com/viewtopic.php?f=30&t=41784
    http://www.eileenslounge.com/viewtopic.php?p=323966#p323966
    http://www.eileenslounge.com/viewtopic.php?p=323959#p323959
    http://www.eileenslounge.com/viewtopic.php?p=323960#p323960
    http://www.eileenslounge.com/viewtopic.php?p=323894#p323894
    http://www.eileenslounge.com/viewtopic.php?p=323843#p323843
    https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa6BSa173Z
    https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa6-64Xpgl
    https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa5ms39yjd
    https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa5ZXJwRCM
    https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa4Pr15NUt
    https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABa4I83JelY
    https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg. 8mjgPNoTt_HABa3tnAjhZU
    https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg. 8mjgPNoTt_HABa3KswxL3c
    https://www.youtube.com/watch?v=suUqEo3QWus&lc=UgyBXFxnVWT3pqtdqPx4AaABAg
    https://www.youtube.com/watch?v=suUqEo3QWus&lc=Ugi53h84LUm5bHgCoAEC.7-H0Z7-COoGABZFQ8vjEvY
    https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABZ8N9O-O8p
    http://www.eileenslounge.com/viewtopic.php?p=323547#p323547
    http://www.eileenslounge.com/viewtopic.php?p=323516#p323516
    http://www.eileenslounge.com/viewtopic.php?p=323517#p323517
    http://www.eileenslounge.com/viewtopic.php?p=323449#p323449
    http://www.eileenslounge.com/viewtopic.php?p=323226#p323226
    http://www.eileenslounge.com/viewtopic.php?f=25&t=41702&p=323150#p323150
    http://www.eileenslounge.com/viewtopic.php?p=323085#p323085
    http://www.eileenslounge.com/viewtopic.php?p=322955#p322955
    http://www.eileenslounge.com/viewtopic.php?f=30&t=41659
    https://www.youtube.com/watch?v=suUqEo3QWus&lc=Ugi53h84LUm5bHgCoAEC.7-H0Z7-COoGABZFQ8vjEvY
    https://www.youtube.com/watch?v=3t8Mk4URi6g&lc=UgzoakhRXOsCaoRm_Nd4AaABAg. 8xzeMdC8IOGABZ8N9O-O8p
    https://www.youtube.com/watch?v=C43btudYyzA&lc=UgxREWxgx2z2Lza_0st4AaABAg
    https://www.youtube.com/watch?v=C43btudYyzA&lc=UgyikSWvlxbWS24NBeR4AaABAg
    https://www.youtube.com/watch?v=C43btudYyzA&lc=UgwNiH4hhyrd2UjDK8d4AaABAg
    https://www.youtube.com/watch?v=C43btudYyzA&lc=Ugyf349Ue6_4umFfNUB4AaABAg. 8mjgPNoTt_HAAf952WoUti
    https://www.youtube.com/watch?v=hz4vb48wzMM&lc=Ugy2N3gvXBNrvWpojqR4AaABAg
    http://www.eileenslounge.com/viewtopic.php?p=322462#p322462
    http://www.eileenslounge.com/viewtopic.php?p=322356#p322356
    http://www.eileenslounge.com/viewtopic.php?p=321984#p321984
    https://eileenslounge.com/viewtopic.php?f=30&t=41610
    https://eileenslounge.com/viewtopic.php?p=322176#p322176
    https://eileenslounge.com/viewtopic.php?p=322238#p322238
    https://eileenslounge.com/viewtopic.php?p=322270#p322270
    https://eileenslounge.com/viewtopic.php?p=322300#p322300
    http://www.eileenslounge.com/viewtopic.php?p=322150#p322150
    http://www.eileenslounge.com/viewtopic.php?p=322111#p322111
    http://www.eileenslounge.com/viewtopic.php?p=322086#p322086
    https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
    Last edited by DocAElstein; 01-09-2025 at 12:55 AM.
    Cheers !

    Excel Range to BBCode Table
    Use Social Networking Tools If You Like the Answers !

    Message to Cross Posters

    @ Home - Office 2010/2013/2016 on Win 10 (64 bit); @ Work - Office 2016 on Win 10 (64 bit)

Similar Threads

  1. Great Circle Midpoint of a line segment
    By Dan1445 in forum Excel Help
    Replies: 0
    Last Post: 11-26-2013, 07:39 AM
  2. Replies: 9
    Last Post: 08-20-2013, 08:45 PM
  3. Solve Block If Without End If Problem
    By jffryjsphbyn in forum Excel Help
    Replies: 3
    Last Post: 06-12-2013, 11:06 AM
  4. Replies: 8
    Last Post: 05-21-2013, 06:34 AM
  5. Formatting Problem while copying data
    By princ_wns in forum Excel Help
    Replies: 3
    Last Post: 04-03-2012, 07:18 PM

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •