Search a String in a Dictionary and if string found replace it with values from text boxes in all worksheets

[PritishS]

Hi,
I'm trying to Search a string in a Dictionary and if found replace it with values from text boxes in all worksheets.
I'm attaching a sample workbook with code for further reference.
What I have tried yet-

1. I have a workbook with many worksheets (around 2000). But in my sample file 3 sheets are there.
2. Each sheet have some data in of pens of different colors.

3. My objective is to consider a pen data to replace with another pen data in entire workbook. For example - I want to replace 'Red color ball point pen' with 'Green color ball point pen' in all worksheets.
4. What I'm doing with my code-
a. Once you click on 'Replace' Button, one userform will open

b. As I have selected 'Red color ball point pen' at row 5, on userform initialize I'm showing selected row number in point-1.
c. After that I'm clicking on 'Get String' button (point-2) to make string in Textbox (point-3).
d. Next I'm selecting row number 6, because I want to replace it with 'Green color ball point pen'. So in Point-4 its the selected row number.
e. Next I'll click on 'Relpace with' button (point-5), which will show data of that selected row (A col data in 1st Textbox, B col data=2nd textbox, C col data = 3rd textbox and D col data =4th textbox.) (Point -6).
f. Next by clicking on 'Replace' button (point-7), I'm trying to search the string 'Red color ball point pen,XYA,RPEN-B' in all worksheets and if found then replace that rows Col-A,B,C & D with
textbox values of Point-6.
e. By clicking on 'Replace' button, I'm creating a dictionary of all item available in sheet1. But unable to compare and replace the found string row with desired value.

Thanks in advance for looking into it.
Sample File with VBA
Meet Google Drive – One place for all your files

Userform VBA I have tried-

Option Explicit
Private Sub CommandButton1_Click()
Dim str As String

With Application
            str = ActiveCell.Value & "," & ActiveCell.Offset(, 1).Value & "," & ActiveCell.Offset(, 2).Value
    End With
Me.TextBox2.Value = str
End Sub

Private Sub CommandButton2_Click()
Me.TextBox3.Value = ActiveCell.Row

Me.TextBox4.Value = Range("A" & ActiveCell.Row).Value
Me.TextBox5.Value = Range("B" & ActiveCell.Row).Value
Me.TextBox6.Value = Range("C" & ActiveCell.Row).Value
Me.TextBox7.Value = Range("D" & ActiveCell.Row).Value

End Sub

Private Sub CommandButton3_Click()
Dim rng As Range, Dn As Range, n As Long, str As String, str1 As String
Dim sht As Worksheet, Q As Variant, Dic As Object, r As Range
Dim answer As Integer, RngD As Range

Set Dic = CreateObject("scripting.dictionary")
     Dic.comparemode = vbTextCompare
   
str1 = Me.TextBox2.Value

With ActiveSheet
            Set rng = .Range(.Range("A5"), .Range("A" & Rows.Count).End(xlUp))
        End With

For Each Dn In rng
        With Application
            str = Dn.Value & "," & Dn.Offset(, 1).Value & "," & Dn.Offset(, 2).Value
        End With
        If Not Dic.Exists(str) Then
                    Dic.Add (str), Array(Dn, 3)
                Else
                    Q = Dic(str)
                    Set Q(0) = Union(Q(0), Dn)
                    Dic(str) = Q
             End If
       Next Dn
      
' '''''''After this i don't have a clue how to proceed.

End Sub

Private Sub UserForm_Initialize()
Me.TextBox1.Value = ActiveCell.Row
End Sub

Thanks & Regrads,
PritishS

 

[mse330]

Hello ... I can't see/download the file as I'm getting this message "You need access, Ask for access, or switch to an account with access."

What do you need the dictionary for ? I don't think it is required for what you need to achieve (if my understanding is correct )

Try the below code [untested] as I couldn't download your file

Private Sub CommandButton3_Click()

Dim a, OldDesc$, Desc$, Make$, Part$, Price#

OldDesc = TextBox2.Value
Desc = textbox4.Value
Make = textbox5.Value
Part = textbox6.Value
Price = textbox7.Value

a = Range("A4").CurrentRegion

For x = 2 To UBound(a)
  If a(x, 1) = OldDesc Then
    a(x, 1) = Desc: a(x, 2) = Make: a(x, 3) = Part: a(x, 4) = Price
  End If
Next
    
Range("A4").Resize(UBound(a), UBound(a, 2)) = a

End Sub

 

[PritishS]

Hi mse330,

Thank you very much for your valuable time. I am going to definitely try your code and give you feedback.
Maybe I uploaded the sample file in google drive without permission.
Here is link to download it from dropbox. Please let me know if its downloadable or not.

Sample Worksheet.xlsm

Thank you once again
PritishS

 

[PritishS]

Hi @mse330,

Just tested your code. As per your understanding the code is working. Thanks for you code. This definitely very useful if someone have that requiremnt.

But, I guess you thought I wanted to check only description in A column from textbox2.value

'Here you are considering only description
OldDesc = TextBox2.Value

'and you are checking description in column A only and updating the new discretion, make, part no and Price in each row, where OldDesc found in A col.
If a(x, 1) = OldDesc Then
    a(x, 1) = Desc: a(x, 2) = Make: a(x, 3) = Part: a(x, 4) = Price
  End If

As per your logic, if I have row having description : "Red color ball point pen" but different Make, Part no and Price, it will also be updated with new description.
But if you see, I'm not using only description from Col-A in Textbox2. I'm making a complete string by joining values from Col-A, B and C

Private Sub CommandButton1_Click()
Dim str As String

With Application
            str = ActiveCell.Value & "," & ActiveCell.Offset(, 1).Value & "," & ActiveCell.Offset(, 2).Value
    End With
Me.TextBox2.Value = str
End Sub

I'm trying to compare that complete string in each row in that sheet by making string of each line's Description, make and price. That's why I'm using a dictionary.
I hope I am able to clarify my requirement. If any further clarification needed, kindly let me know.
Also check my sample file, Sample Worksheet.xlsm

Thanks again
PritishS

 

[mse330]

Hi @PritishS

I still don't think you need a dictionary for what you're doing. You can simply check against all 4 elements (fields) in the array & if there's a match, apply the change. Try the below code ... Just noticed something, you have 2000 sheets in your file !! I have never had a file with anything close to that so if you don't need to loop through all sheets, perhaps you could select the required sheets only

Private Sub CommandButton3_Click()

Dim a, OldDesc$, Desc$, Make$, Part$, Price#, ws As Worksheet

OldDesc = TextBox2.Value
Desc = TextBox4.Value
Make = TextBox5.Value
Part = TextBox6.Value
Price = TextBox7.Value

For Each ws In Sheets
  a = ws.Range("A4").CurrentRegion
  For x = 2 To UBound(a)
    If a(x, 1) = OldDesc And a(x, 2) = Make And a(x, 3) = Part And a(x, 4) = Price Then
      a(x, 1) = Desc: a(x, 2) = Make: a(x, 3) = Part: a(x, 4) = Price
    End If
  Next
  ws.Range("A4").Resize(UBound(a), UBound(a, 2)) = a
Next

End Sub

 

[PritishS]

Hi, Many Thanks for your code. Let me try this right away and update you.