Help with replacement string

[rsuarema7]

Hello guys,

I just recently registered to the forum & thought you could help me out with a macro I am trying to build...

My VBA notion are very basic. I started a couple of weeks ago, so I am still trying to get my head around some stuff.

I am trying to replace some food codes in my survey with the corresponding description as per the USDA codes:

In column A ("Food code"), I have the food codes the survey participants consumed on that day (I have more than 1,000 different codes). The other columns are basically the "legend": in column B ("USDA code"), you can find the all available codes, whilst the corresponding description is found in column C ("Description").

What I want to do is to replace the food codes in column A ("Food Code") with the values in column C ("description"). So, theoretically, VBA should take cell A2 (94000100) & scan column B ("USDA codes") & then replace with the text in column C ("Description") once it finds 94000100 in column B.

Hope this makes sense.

I tried something super basic which is super wrong as I believe it only looks for direct matches:

Sub rplc()
Dim sh As Worksheet, lr As Long, rng As Range, c As Range
Set sh = Day1consumption
lr = sh.Cells(Rows.Count, 2).End(xlUp).Row
Set rng = sh.Range("B2:B" & lr)
For Each c In rng
sh.Range("A:A").Replace What:=c.Value, Replacement:=c.Offset(0, 1).Value, LookAt:=xlPart, MatchCase:=False
Next
End Sub

Thank you very much for your help guys!

 

[Jimmypop]

Hi there

Let us know if this maybe works... On a quick test it did for me, however as you stated there is lots of other data.. the only thing that went wonky for me is the first two lines Milk, Human and Milk, NFS... My code keeps giving result as below (thinking it is because the Food Codes are the same... not sure how to negate this issue...) else if I changed the second food code to not be the same as the previous one then it does copy over...

Please let us know if it works... else someone else can also give it a go... (If I did something wrong somewhere... please excuse seeing as I am trying to learn)

Sub rplc()
'Declare variables with Dim statement
    Dim sh As Worksheet, lr As Long, rng As Range, c As Range
'Assign values to the variables
    Set sh = Sheets(1) 'Edit sheet name
    lr = sh.Cells(Rows.Count, 2).End(xlUp).Row 'Finds limit of range in column B
    Set rng = sh.Range("B2:B" & lr) 'Assigns column B range to object variable
    For Each c In rng 'Creates object variable representing a cell in column B
'The following replaces any item in column A with the value of the cell in column C
'if it matches the cell in column B.
        sh.UsedRange.Replace What:=c.Offset(0, -1).Value, Replacement:=c.Offset(0, 1).Value, LookAt:=xlWhole, MatchCase:=True
    Next 'Goes to next cell in column B until range limit is reached.
End Sub

 

[rsuarema7]

Thanks Jimmy!

I think I may not have made myself as clear as I wanted...!

The table I included was only to show up the three columns - column A has more than 1M values, whilst columns B & C are limited to approx. 10k unique & unrepeated values.

I was trying to build a code that would take the value in A2 (94000100) & look for it in Column B ('USDA code). The numbers in column B as in ascending order, so it should find its match about the end of it. That USDA code has the "water, tap" description associated.

Ideally, the code would run the check & end up telling me that A2 corresponds to "water, tap" based on columns B & C. It should do the same for every single value in column A (I have more than 10k inputs there vs 1M in column A).

Thanks!

 

[Jimmypop]

I have tried and no viable solution yet... there should be a simple way( even a one line formula ) that should be able to do this... Cannot work further on this unfortunately seeing as it is month end with the company... maybe someone else can give a go?

 

[Alex Blakenburg]

I would normally use a dictionary but since you also have Mac OS on your profile this uses a collection.
It didn't seem to make sense to overwrite column A to I have put your columns B&C on a a separate sheet called Food Codes but still in columns B&C and am writing the descriptions in columns B of the sheet Day1consumption.

Sub GetFoodCodeDescription()

    Dim shtMain As Worksheet, shtCodes As Worksheet
    Dim rngMain As Range, rngCodes As Range
    Dim arrMain As Variant, arrCodes As Variant
    Dim collCodes As Collection
    Dim lrowMain As Long, lrowCodes As Long
    Dim i As Long
   
    Set shtMain = Worksheets("Day1consumption")
    Set shtCodes = Worksheets("Food Codes")
   
    With shtMain
        lrowMain = .Cells(Rows.Count, "A").End(xlUp).Row
        Set rngMain = .Range("A2:A" & lrowMain)
        arrMain = rngMain
    End With
   
    With shtCodes
        lrowCodes = .Cells(Rows.Count, "B").End(xlUp).Row
        Set rngCodes = .Range("B2:C" & lrowCodes)
        arrCodes = rngCodes
    End With

    ' Load code collection
    Set collCodes = New Collection
    On Error Resume Next
        For i = 1 To UBound(arrCodes)
            collCodes.Add arrCodes(i, 2), CStr(arrCodes(i, 1))
        Next i
    On Error GoTo 0
   
    ' Get Food Code description
    ReDim Preserve arrMain(1 To UBound(arrMain, 1), 1 To 2) ' Add description column to array
    On Error Resume Next
        For i = 1 To UBound(arrMain)
            arrMain(i, 2) = collCodes.Item(CStr(arrMain(i, 1)))
        Next i
    On Error GoTo 0
   
    ' Write updated list
    rngMain.Resize(, 2).Value = arrMain

End Sub

My Output Data looks like this:-

20220801 VBA Dict or Coll Match rsuarema7.xlsm
	A	B	C
1	Food code
2	94000100	Water, tap
3	94000100	Water, tap
4	56205008	Rice, white, cooked, no added fat
5	55100010	Pancakes, plain, from frozen
6	21101000	Beef steak, NS as to cooking method, NS as to fat eaten
7	61210250	Orange juice, 100%, with calcium added, canned, bottled or in a carton
8	61210250	Orange juice, 100%, with calcium added, canned, bottled or in a carton
9	61210250	Orange juice, 100%, with calcium added, canned, bottled or in a carton
10	14107010	Cheese, Mozzarella, NFS
11	56205008	Rice, white, cooked, no added fat
12	91746100	M&M's Milk Chocolate Candies
13	24168021	Chicken "wings" with other sauces or seasoning, from other sources
14	91300100	Pancake syrup
15
Day1consumption

My Food Code Sheet looks like this:

20220801 VBA Dict or Coll Match rsuarema7.xlsm
	A	B	C
1		USDA code	Description
2		14107010	Cheese, Mozzarella, NFS
3		21101000	Beef steak, NS as to cooking method, NS as to fat eaten
4		24168021	Chicken "wings" with other sauces or seasoning, from other sources
5		55100010	Pancakes, plain, from frozen
6		56205008	Rice, white, cooked, no added fat
7		61210250	Orange juice, 100%, with calcium added, canned, bottled or in a carton
8		91300100	Pancake syrup
9		91746100	M&M's Milk Chocolate Candies
10		94000100	Water, tap
Food Codes