I am new to VBA, and am an extremely bad coder to begin with.
Essentially what I need to do is take a product key value, compare that key value in a list of thousands, and replace that product key value with the new updated value.
I am a picture learner so this is what I am working with extremely simplified:
V
V
I have some code that I am currently writing, and have tried looking up a lot of different built in functions that I can work with, but I am really lost.
Sub SwapNumbers()
Dim OldNumber As Integer
Dim myrange As Range
Dim NewNumber As Integer
' Select Current Cell
OldNumber = ActiveCell.Value
My first main question, is how do I set a variable to be able to cover a row range so large? I know I will have to change the variable type if I change it. But I am thinking is it possible to maybe do a loop that might be able to run through every row in a certain column until it finds the number then stops?
'Compare Cell Value (Old Number) to List of Numbers (Col 1)
Set myrange = Worksheets("Sheet 2").Range("A2:A1712")
For Each cell In myrange
If IsNumeric(Application.Match(OldNumber, myrange, 0)) Then
NewNumber = myrange.Value
End If
Next
If that is the case, once I find that cell, how do I save it to then make sure I can move over to a new column to find the new product key value? 'If found Old number match (Col 1) jump to New number (Col 2)
And I guess this next part is pretty simple, I just have to figure out the correct syntax....
'Input New number (Col 2) into selected cell
End Sub
I hope this makes sense? I feel like I am vastly overcomplicating this. Or maybe not making it complicated enough. Who knows.
CodePudding user response:
I've gone overboard with the comments so that your 'newness' to VBA doesn't impede your understanding:
Sub SwapNumbers()
Dim src As Range 'reference old data on worksheet
Dim srcArr As Variant 'reference old data in memory
Dim i As Long
Dim current As Variant 'reference Match result
Dim lookUp As Range ' reference 1st column of 'conversion table'
Dim lookUpTable As Variant 'reference 1st 4 columns of 'conversion table' in memory
Set src = Worksheets("Sheet1").Range("A3") 'assumed location of cell containing 'Product ID'
Set lookUp = Worksheets("Sheet2").Range("A2") 'assumed location of cell containing 'OldProdID'
Set src = Range(src, src.End(xlDown)).Resize(, 2) 'increase src for 1st 2 columns, and all rows (until blank)
srcArr = src.Value2 'write src values to memory'
Set lookUp = Range(lookUp, lookUp.End(xlDown))
lookUpTable = Range(lookUp, lookUp.End(xlDown)).Resize(, 4).Value2
For i = 2 To UBound(srcArr, 1) 'starting at 2 because headers in 1st position'
current = Application.Match(srcArr(i, 1), lookUp, 0)
If IsNumeric(current) Then
srcArr(i, 1) = lookUpTable(current, 3) 'update with data from 3rd column of 'conversion table'
srcArr(i, 2) = lookUpTable(current, 4)
End If
Next i
src.Value2 = srcArr 'Overwrite src range with updated contents from memory
End Sub
(obviously the Set src
and Set lookUp
lines should be adjusted, as my assumptions probably don't represent the correct references of your actual cells)
CodePudding user response:
Replace Numbers (Ids) Using a Dictionary
Sub ReplaceIds()
' Source
Const sName As String = "Sheet2"
Const slFirstCellAddress As String = "A3" ' l - Lookup
Const svCol As String = "C" ' v - Value
' Destination
Const dName As String = "Sheet1"
Const dFirstCellAddress As String = "A4"
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Write the ids to arrays.
Dim sws As Worksheet: Set sws = wb.Worksheets(sName)
Dim lCell As Range
Dim slData As Variant
Dim svData As Variant
Dim rCount As Long
With sws.Range(slFirstCellAddress)
Set lCell = .Resize(sws.Rows.Count - .Row 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Sub ' no data in column range
rCount = lCell.Row - .Row 1
With .Resize(rCount)
If rCount = 1 Then ' one row
ReDim slData(1 To 1, 1 To 1): slData(1, 1) = .Value
ReDim svData(1 To 1, 1 To 1)
svData(1, 1) = .EntireRow.Columns(svCol).Value
Else ' multiple rows
slData = .Value
svData = .EntireRow.Columns(svCol).Value
End If
End With
End With
' Write the ids (numbers) from the arrays to a dictionary.
Dim dict As Object: Set dict = CreateObject("Scripting.Dictionary")
Dim r As Long
For r = 1 To rCount
If VarType(slData(r, 1)) = vbDouble Then
If VarType(svData(r, 1)) = vbDouble Then
dict(slData(r, 1)) = svData(r, 1)
End If
End If
Next r
If dict.Count = 0 Then Exit Sub ' no numeric data
' Delete the arrays (the relevant data is in the dictionary).
Erase slData
Erase svData
' Write the destination ids from the range to an array.
Dim dws As Worksheet: Set dws = wb.Worksheets(dName)
Dim drg As Range
Dim dData As Variant
With dws.Range(dFirstCellAddress)
Set lCell = .Resize(sws.Rows.Count - .Row 1) _
.Find("*", , xlFormulas, , , xlPrevious)
If lCell Is Nothing Then Exit Sub ' no data in column range
rCount = lCell.Row - .Row 1
Set drg = .Resize(rCount)
If rCount = 1 Then ' one row
ReDim dData(1 To 1, 1 To 1): dData(1, 1) = drg.Value
Else ' multiple rows
dData = drg.Value
End If
End With
' Loop through the values in the array to replace the old ids with new ones.
For r = 1 To rCount
If VarType(dData(r, 1)) = vbDouble Then
If dict.Exists(dData(r, 1)) Then
dData(r, 1) = dict(dData(r, 1))
End If
End If
Next r
' Write the modified ids back to the range.
drg.Value = dData
' Inform.
MsgBox "Old ids replaced.", vbInformation
End Sub