Cells.Replace functions for similar wording - excel

Question

I inherited an Excel macro for use with my companies' bank deposits. I was able to read line by line and figure out how the macro worked.
There's so many Cells.Replace functions that 32 bit Excel throws
"Compile Error: Procedure too large".
I need to slim it down. For example:
Cells.Replace What:="DIRECT DEPOSIT COMPANY A OF CALIFORNIA", Replacement:="COMPANY", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Cells.Replace What:="DIRECT DEPOSIT COMPANY A UTAH SECTOR", Replacement:="COMPANY", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
Both are from the same company, and treated as such afterwards, but because they have slightly different names I've been adding a new function for every one.
I assumed that because it is using 'LookAt:=xlPart" I'd be able to say:
Cells.Replace What:="DIRECT DEPOSIT COMPANY", Replacement:="COMPANY", LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
But I end up with "COMPANY", + everything after what is specified in the What function tacked onto the end.
Is there a more streamlined method of finding all cells starting with "DIRECT DEPOSIT COMPANY A", disregarding anything after that, and replacing with just "COMPANY"?

Answer 1

Here's how you can run repeated "replace all if starts with" replacements:
Sub tester()
ReplaceStartsWith "COMPANY A", "COMPANY"
ReplaceStartsWith "COMPANY B", "COMPANY"
End Sub
Sub ReplaceStartsWith(startsWith, replaceWith)
Cells.Replace what:=startsWith & "*", replacement:=replaceWith, lookat:=xlWhole
End Sub
Note you might want to add a space at the end of the startsWith if you don't want (eg) "COMPANY A" to match "COMPANY ADVANCED"