Macro to find and replace values in several columns of a table

[mojo707]

Hi,

I have the following macro which replaces the data in cells that are not blank within several columns in an Excel table, however the macro takes more than two hours to run due to the size of the table (40,000 rows and 50 columns). Is there a more efficient code I could use that would achieve the same result faster?

Sub PersonalDetails()


With ThisWorkbook.Worksheets("ActiveWorkers")
For a = 1 To 10000
If Range("Table145[Emergency Contacts]")(a) > 0 Then
If Range("Table145[Emergency Contacts]")(a) = "" Then
Exit Sub
End If
Range("Table145[Emergency Contacts]")(a) = "X"
End If
Next

For b = 1 To 10000
If Range("Table145[Home Address]")(b) > 0 Then
If Range("Table145[Home Address]")(b) = "" Then
Exit Sub
End If
Range("Table145[Home Address]")(b) = "X"
End If
Next

For c = 1 To 10000
If Range("Table145[Home Phone]")(c) > 0 Then
If Range("Table145[Home Phone]")(c) = "" Then
Exit Sub
End If
Range("Table145[Home Phone]")(c) = "X"
End If
Next

For d = 1 To 10000
If Range("Table145[Mobile Phone Number]")(d) > 0 Then
If Range("Table145[Mobile Phone Number]")(d) = "" Then
Exit Sub
End If
Range("Table145[Mobile Phone Number]")(d) = "X"
End If
Next

For e = 1 To 10000
If Range("Table145[Email - Home]")(e) > 0 Then
If Range("Table145[Email - Home]")(e) = "" Then
Exit Sub
End If
Range("Table145[Email - Home]")(e) = "X"
End If
Next
End With
MsgBox "Finished replacing " & CStr(dblCnt) & " items", vbOKOnly, "Complete"


End Sub

 

[Fluff]

Do the columns you want to work on contain formulae?

 

[mojo707]

Do the columns you want to work on contain formulae?

No, there are no formulae in those columns

 

[Fluff]

In that case try

Sub mojo707()
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Array("Emergency Contacts", "Home Address", "Home Phone", "Mobile Phone Number")
   For i = 0 To UBound(Ary)
      Range("Table145[" & Ary(i) & "]").SpecialCells(xlConstants).Value = "X"
   Next i
End Sub

Just add the rest of the Column names to the array

 

[mojo707]

In that case try

Sub mojo707()
   Dim Ary As Variant
   Dim i As Long
   
   Ary = Array("Emergency Contacts", "Home Address", "Home Phone", "Mobile Phone Number")
   For i = 0 To UBound(Ary)
      Range("Table145[" & Ary(i) & "]").SpecialCells(xlConstants).Value = "X"
   Next i
End Sub

Just add the rest of the Column names to the array

Thankyou! it worked nicely. What took almost 2 hours before took less than 10 seconds!

 

[mojo707]

I also have a situation in the same worksheet where I need to do what I would describe as a 'conditional replace'.
For example I have two columns A and B. If the value in a given row in column A is the same as the value in the corresponding row in column B then I want to replace both values with the word "Match". Similarly, if the value for a given row in column A is not the same as the value in the corresponding row in column B (including the scenario that one cell is blank and the other is not blank) then I want to replace the value in column A with the text "P" and the corresponding value in column B with the text "Q".
I am doing this manually using the filters, entering the desired values manually and dragging down to replace but with 40,000 rows and lots of blanks this does take some time.
Could a macro automate this?

 

[Fluff]

It can be done with a macro, but as this is a different question, you will need to start a new thread.