I have a workbook with a table that is roughly 20000 rows in size and 52 columns. At times, I need to update a percentage of select rows at once. I'm hoping to use a macro to update the select cells based on a value in the row, mapped out by a second smaller table with the updated values to be entered in to table 1. Almost like a VLOOKUP function, but one that doesn't erase the cell if the entry isn't found. For example, change the Phone Number according to the Host ID.
I tried to do this with an Array in the code below for a specfic set of the values in Table 1, but my values didn't update. My VBA is a bit rusty, so if someone can review and assist with getting this to function, it would be appreciated. I would like to make it update any entry in the table based on the table headers eventually.
Sub NewNameandCostCenter()
Dim myList, myRange
Dim sht As Worksheet
Dim sht2 As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell As Range
Dim LastRow2 As Long
Set sht = Worksheets("NewNameMacro")
Set sht2 = Worksheets("ALL")
Set StartCell = Range("A2")
'Find Last Row and Column
LastRow = sht.Cells(sht.Rows.Count, StartCell.Column).End(xlUp).Row
LastColumn = sht.Cells(StartCell.Row, sht.Columns.Count).End(xlToLeft).Column
'set myList array
Set myList = sht.Range(StartCell, sht.Cells(LastRow, LastColumn))
LastRow2 = sht.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
'set myRange array
Set myRange = Sheets("ALL").Range("J2:M" & LastRow2)
'Update values of cells adjacent
For Each cel In myList.Columns(1).Cells
myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 1).Value, LookAt:=xlWhole
myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 2).Value, LookAt:=xlWhole
myRange.Replace What:=cel.Value, Replacement:=cel.Offset(0, 3).Value, LookAt:=xlWhole
Next cel
End Sub
Thanks, JD
If I understand your question correctly, you're effectively running an UPDATE query against your data, based on the values in your mapping table.
I've assumed the following:
The "key" column is the first column in your data table and in your mapping table.
The columns in your mapping table are in the same order and relative position as the columns in the data table (although this could easily be adjusted.
The order of the keys in the mapping table and the data table is unsorted. If you can ensure that the keys are sorted (ideally in both sheets), then you could achieve substantially better performance with some slight modifications.
I've hard-coded the ranges in my example, but you can reinstate the last row and last column approach if you need to.
I've done all of my comparisons between arrays instead of ranges, and I've done away with the Find approach. You'll find that this works, and works much more efficiently.
Option Explicit
Sub NewNameandCostCenter()
Dim start As Double
start = Timer
Dim countOfChangedRows As Long
'set rngMap array
Dim rngMap As Range
Set rngMap = Worksheets("Map").Range("A1:D51")
'set rngData array
Dim rngData As Range
Set rngData = Worksheets("Data").Range("J2:M20001")
Dim aMap As Variant
aMap = rngMap.Value
Dim aData As Variant
aData = rngData.Value
Dim mapRow As Long
Dim datarow As Long
Dim mapcol As Long
For mapRow = LBound(aMap, 1) To UBound(aMap, 1)
For datarow = LBound(aData) To UBound(aData)
'Check the key matches in both tables
If aData(datarow, 1) = aMap(mapRow, 1) Then
countOfChangedRows = countOfChangedRows + 1
'Assumes the columns in map and data match
For mapcol = LBound(aMap, 2) + 1 To UBound(aMap, 2)
aData(datarow, mapcol) = aMap(mapRow, mapcol)
Next mapcol
End If
Next datarow
Next mapRow
rngData.Value = aData
Debug.Print countOfChangedRows & " of "; UBound(aData, 1) & " rows updated in " & Timer - start & " seconds"
End Sub
The performance is reasonable for 50 updated rows:
50 of 20000 rows updated in 0.23828125 seconds
But if you need to start updating thousands of rows, then you would benefit greatly from ensuring the data is sorted and tweaking the code accordingly.
If you love us? You can donate to us via Paypal or buy me a coffee so we can maintain and grow! Thank you!
Donate Us With