Combining VBA Codes to perform Singular result

[kawliga]

Hello,

I have two VBA codes (not created by me) that perform separate functions that work well independently but I'm now trying to change the criteria for one of the functions and was hoping to possibly do everything I need with one combined code.

The first code searches my data for all 7 digit telephone numbers and changes them to a 10 digit number with a specific area code (in this case 315).

Example:

Column A
5924168

Column B
[TABLE="width: 590"]
<tbody>[TR]
[TD="width: 590"]CWT 3WC DGT PIC 0893 Y SC2 CFDA N NSCR 1 A 24 FIXRING 5936245 CFBL N NSCR 1

Column C
[TABLE="width: 602"]
<tbody>[TR]
[TD="width: 602"]PIC 0444 Y LPIC 0444 Y CFU N 5936245 I $ CFB N 5936245 A $ CBU CFD N

Column D (Result Column)
CWT 3WC DGT PIC 0893 Y SC2 CFDA N NSCR 1 A 24 FIXRING 3155936245 CFBL N NSCR 1

Column E (Result Column)
PIC 0444 Y LPIC 0444 Y CFU N 3155936245 I $ CFB N 3155936245 A $ CBU CFD N



[/TD]
[/TR]
</tbody>[/TABLE]
[/TD]
[/TR]
</tbody>[/TABLE]

-------------------------------------------------------------------------------------------------------------------------------
Option Explicit

Public Function PREPEND(ByVal Cell As Range)
Static REX As Object

If REX Is Nothing Then
Set REX = CreateObject("VBScript.RegExp")
End If

With REX
.Global = True
.Pattern = "\b[0-9]{7}\b"
If .Test(Cell.Value2) Then
PREPEND = .Replace(Cell.Value2, "315$&")
Else
PREPEND = Cell.Value2
End If
End With

End Function

------------------------------------------------------------------------------------------------------------------------------


This codes works perfectly but now I've found that I have some 8 digit numbers (almost exclusively beginning with a 9) that I would like the code to A) search both Column C & D for either 7 or 8 digit B)change the 7 digit as it does now C)change the 1st digit or any 8 digit to be the 1st digit then the needed area code ( i.e. 95919182 changed to 93155919182).

******************************************************************************************

The next code I have searches my test string for anything beginning with "CF" and then pulls the CF plus what the CF feature is forwarded to within in the string

-------------------------------------------------------------------------------------------------------------------------------

Function CFs(Rng As Range) As String
Dim X As Long, Z As Long, CF() As String
CFs = Rng(1).Value
CF = Split(" " & Application.Trim(Join(Application.Index(Range(Rng(2), Rng(Rng.Count)).Value, 1, 0))), " CF", , vbTextCompare)
For X = 1 To UBound(CF)
For Z = 1 To Len(CF(X))
If Mid(CF(X), Z, 10) Like "##########" Then
CFs = CFs & " CF" & Left(CF(X), Z + 9)
Exit For
End If
Next
Next
End Function

-------------------------------------------------------------------------------------------------------------------------------

Example:

Column A
2974447

Column B
CWT 3WC DGT PIC 0893 Y SC2 CFW C NSCR 1 I 19786977999 LPIC 0893 Y

Column C
1 A 24 FIXRING 3155936245 CFBL N NSCR 1 A 3155936245 LPIC 0893 Y

Column D (Result Column)
4022311 CFDA N NSCR 1 A 24 FIXRING 3155936245 CFBL N NSCR 1 A 3155936245

This code also works perfectly. However, I now have some records that have a number (1 or 2 digit) spaces then the CF and then the forward to number

Example:

Column A
59224741

Column B
6 CFU N 31595925390 I $

Column C
6 CFD N 31595936245 A $

-----------------------------------------------------------------------------------------------------------------------------

I would like any help in trying to A)Combine both VBA B)Make the desired changes to both C)Combine in one VBA code

Yes, I realize I am asking for the moon.

Any help would be GREATLY appreciated!!!

 

[BrutalDawg]

A simple solution is to use your Macro recorder and run both macros or write a code.

Sub AllMacros()
macro1
macro2
macro3
macro4
End Sub