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

mojo707

New Member
Joined
Jun 7, 2015
Messages
21
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
 

Excel Facts

Highlight Duplicates
Home, Conditional Formatting, Highlight Cells, Duplicate records, OK to add pink formatting to any duplicates in selected range.
Do the columns you want to work on contain formulae?
 
Upvote 0
In that case try
Code:
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
 
Upvote 0
In that case try
Code:
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!
 
Upvote 0
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?
 
Upvote 0
It can be done with a macro, but as this is a different question, you will need to start a new thread.
 
Upvote 0

Forum statistics

Threads
1,213,543
Messages
6,114,236
Members
448,555
Latest member
RobertJones1986

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