Help with replacement string

rsuarema7

New Member
Joined
Jul 29, 2022
Messages
2
Office Version
  1. 365
Platform
  1. Windows
  2. MacOS
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:

1659091836912.png


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!
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.
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)

Screenshot 2022-07-29 141956.png

VBA Code:
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
 
Upvote 0
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).

1659106081338.png


Thanks!
 

Attachments

  • 1659106050559.png
    1659106050559.png
    7.4 KB · Views: 5
Upvote 0
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?
 
Upvote 0
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.

VBA Code:
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
ABC
1Food code
294000100Water, tap
394000100Water, tap
456205008Rice, white, cooked, no added fat
555100010Pancakes, plain, from frozen
621101000Beef steak, NS as to cooking method, NS as to fat eaten
761210250Orange juice, 100%, with calcium added, canned, bottled or in a carton
861210250Orange juice, 100%, with calcium added, canned, bottled or in a carton
961210250Orange juice, 100%, with calcium added, canned, bottled or in a carton
1014107010Cheese, Mozzarella, NFS
1156205008Rice, white, cooked, no added fat
1291746100M&M's Milk Chocolate Candies
1324168021Chicken "wings" with other sauces or seasoning, from other sources
1491300100Pancake syrup
15
Day1consumption


My Food Code Sheet looks like this:
20220801 VBA Dict or Coll Match rsuarema7.xlsm
ABC
1USDA codeDescription
214107010Cheese, Mozzarella, NFS
321101000Beef steak, NS as to cooking method, NS as to fat eaten
424168021Chicken "wings" with other sauces or seasoning, from other sources
555100010Pancakes, plain, from frozen
656205008Rice, white, cooked, no added fat
761210250Orange juice, 100%, with calcium added, canned, bottled or in a carton
891300100Pancake syrup
991746100M&M's Milk Chocolate Candies
1094000100Water, tap
Food Codes
 
Upvote 0

Forum statistics

Threads
1,213,536
Messages
6,114,202
Members
448,554
Latest member
Gleisner2

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