VBA Combine macros in one depending on text string

ArtyS20

New Member
Joined
Oct 1, 2020
Messages
12
Office Version
  1. 2016
Platform
  1. Windows
Hello:

I have 2 different macros that I would like to combine into one macro depending on the text in one of the columns.

Dataset has several columns/rows and column C (named "TYPE"), can have different values, all are strings. If cell equals "TYPE_A", then I want the 1st macro to work and if it equals "TYPE_B" I want the 2nd macro to work. If it contains anything else, I don't want anything to be done.

Here are the 2 macros I'm currently working with:

VBA Code:
Sub Format_Inflation()

Dim SelRange As Range
Dim ColNum As Integer
Dim CWS As Worksheet, TmpWS As Worksheet

Set CWS = ActiveSheet
ColNum = Application.WorksheetFunction.Match("DEAL_MARKET_DATA", CWS.Rows(1), 0)

Set SelRange = CWS.Columns(ColNum)

Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
       
Dim lr As Long
Dim r As Long
Dim arr() As String
Dim i As Long
   
    Application.ScreenUpdating = False
   
    lr = Cells(Rows.Count, (ColNum)).End(xlUp).Row
   
    If lr < 2 Then Exit Sub
   
    For r = 2 To lr
        If Cells(r, (ColNum)) <> "" Then
            arr = Split(Cells(r, (ColNum)), ";")
            'If Not IsEmpty(arr) Then
                i = UBound(arr)
                'End If
            If i > 0 Then
                Cells(r, (ColNum)) = arr(i - 13)
            End If
        End If
    Next r
   
    Application.ScreenUpdating = True

End Sub

VBA Code:
Sub Format_Mtg()

Dim SelRange As Range
Dim ColNum As Integer
Dim CWS As Worksheet, TmpWS As Worksheet

Set CWS = ActiveSheet
ColNum = Application.WorksheetFunction.Match("DEAL_MARKET_DATA", CWS.Rows(1), 0)

Set SelRange = CWS.Columns(ColNum)

Selection.Replace What:=" ", Replacement:="", LookAt:=xlPart, _
        SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
        ReplaceFormat:=False
       
Dim lr As Long
Dim r As Long
Dim arr() As String
Dim i As Long
   
    Application.ScreenUpdating = False
   
    lr = Cells(Rows.Count, (ColNum)).End(xlUp).Row
   
    If lr < 2 Then Exit Sub
   
    For r = 2 To lr
        If Cells(r, (ColNum)) <> "" Then
            arr = Split(Cells(r, (ColNum)), ";")
            'If Not IsEmpty(arr) Then
                i = UBound(arr)
                'End If
            If i > 0 Then
                Cells(r, (ColNum)) = arr(i - 5)
            End If
        End If
    Next r
   
    Application.ScreenUpdating = True

End Sub

Thanks
 

Excel Facts

Formula for Yesterday
Name Manager, New Name. Yesterday =TODAY()-1. OK. Then, use =YESTERDAY in any cell. Tomorrow could be =TODAY()+1.
Hi ArtyS20,

What is triggering the macros to run? Is it based on a worksheet event (change, selection change, etc.)? The code between the two looks very similar, is the only difference "arr(i - 5)" and arr(i - 13)"? If yes, you could have one Sub and pass the variable (5 or 13) to it with a call. The worksheet event could have the logic to decide what information to pass or do nothing.

Hope that helps,

Doug
 
Upvote 0
It would be easier to help if you could use the XL2BB add-in (icon in the menu) to attach a screenshot (not a picture) of your sheet. Alternately, you could upload a copy of your file to a free site such as www.box.com or www.dropbox.com. Once you do that, mark it for 'Sharing' and you will be given a link to the file that you can post here. Explain in detail what you want to do referring to specific cells, rows, columns and sheets using a few examples from your data (de-sensitized if necessary).
 
Upvote 0

Forum statistics

Threads
1,223,164
Messages
6,170,444
Members
452,326
Latest member
johnshaji

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