Looking for way to simplify this macro.

Culaff

New Member
Joined
Feb 17, 2016
Messages
27
Hello all,

Is there any way to simplify this given macro? I am changing name for 5 headers, in the future, I may have the need to change 1000.

Code:
Sub RenamePServer()
Application.DisplayAlerts = False
Dim Found1, Found2, Found3, Found4, Found5
Set Found1 = Rows(1).Find(what:="Juridiction Code", LookIn:=xlValues, lookat:=xlWhole)
Set Found2 = Rows(1).Find(what:="Juridiction Code Text", LookIn:=xlValues, lookat:=xlWhole)
Set Found3 = Rows(1).Find(what:="GRN/SE No", LookIn:=xlValues, lookat:=xlWhole)
Set Found4 = Rows(1).Find(what:="GRN/SE Dt", LookIn:=xlValues, lookat:=xlWhole)
Set Found5 = Rows(1).Find(what:="GRN/SE Yr", LookIn:=xlValues, lookat:=xlWhole)

If Found1 Is Nothing Then
MsgBox ("Juridiction Code Missing")
GoTo Code1
Else:
Found1.Value = "Business Place"
End If


Code1:
If Found2 Is Nothing Then
MsgBox ("Juridiction Code text Missing")
GoTo Code2
Else:
Found2.Value = "Business Place Des"
End If


Code2:
If Found3 Is Nothing Then
MsgBox ("GRN/SE No Missing")
GoTo Code3
Else:
Found3.Value = "GRN Number"
End If


Code3:
If Found4 Is Nothing Then
MsgBox ("GRN/SE Dt Missing")
GoTo Code4
Else:
Found4.Value = "GRN Date"
End If


Code4:
If Found5 Is Nothing Then
MsgBox ("GRN/SE Yr Missing")
Exit Sub
Else:
Found5.Value = "GRN Year"
End If

End Sub


Thanks for your time guys.
 

Excel Facts

How to change case of text in Excel?
Use =UPPER() for upper case, =LOWER() for lower case, and =PROPER() for proper case. PROPER won't capitalize second c in Mccartney
Create a sheet called "labelUpdates" having a list with all the expected import labels and the new labels.

Like the following sheet (list must begin at A3)


Book1
ABC
1import labelnew label
2
3Juridiction CodeBusiness Place
4Juridiction Code TextBusiness Place Des
5GRN/SE NoGRN Number
6GRN/SE DtGRN Date
7GRN/SE YrGRN Year
8
9
labelUpdates


Go to the Visual Basic Editor (ALT+F11)

In the project explorer (if you don't see it, press Ctrl+r) select the sheet you just made. In the properties pane (F4) change the first item (name) to "labelUpdates". Now in the same way select the sheet that recieves the data and change it's name to "import".
Right-click the project and select insert --> module. In the Code window that opens paste the following code.

Code:
Option Explicit

Sub updateLabels()
   Dim labelUpdate() As Variant
   Dim luRow         As Long
   Dim importColumn  As Long
   Dim found         As Boolean
   Dim uMsg          As String
   Dim mMsg          As String
   
   labelUpdate = labelUpdates.Range("A3").CurrentRegion
   
   For importColumn = 1 To _
         import.Cells(1, import.Columns.Count).End(xlToLeft).Column
   
      found = False
      For luRow = 1 To UBound(labelUpdate)
         
         If import.Cells(1, importColumn).Value = labelUpdate(luRow, 1) Then
            import.Cells(1, importColumn).Value = labelUpdate(luRow, 2)
            found = True
            labelUpdate(luRow, 2) = "!found!"
            Exit For
         End If
      Next luRow
      
      If Not found Then uMsg = uMsg & vbLf & import.Cells(1, importColumn).Value
   Next importColumn
   
   For luRow = 1 To UBound(labelUpdate)
      If labelUpdate(luRow, 2) <> "!found!" Then _
         mMsg = mMsg & vbLf & labelUpdate(luRow, 1)
   Next luRow
   
   If uMsg > "" Then MsgBox Mid(uMsg, 2), vbOKOnly, "unknown labels"
   If mMsg > "" Then MsgBox Mid(mMsg, 2), vbOKOnly, "missing labels"
End Sub

Now if you want to process more codes in the future, just add them to the labelUpdates sheet.
 
Upvote 0
Hey Ask2tsp,

I was wondering, can this code run if we maintain "Labelupdates" sheet in a separate workbook?

Cheers,
Neal
 
Upvote 0
Culaff, since we are on a forum, it would be nice if you showed what you did to make that work. So other people searching this forum for answers may learn a bit from your solution.
 
Upvote 0
For the record the free download I pointed you towards does everything listed on this thread, including provide the option to work with other workbooks / worksheets. It's a complete file requiring no further work, and is fully commented to explain what is happening.
 
Upvote 0
For the record the free download I pointed you towards does everything listed on this thread, including provide the option to work with other workbooks / worksheets. It's a complete file requiring no further work, and is fully commented to explain what is happening.

I investigated your pointer and thank you for that. It is indeed a useful utility. For this case however not quite suitable for two reasons: 1. You always have to go through the dialog (pick a workbook, select sheet on that wb) and 2. You have to open the wb yourself before running this.
 
Upvote 0

Forum statistics

Threads
1,213,506
Messages
6,114,024
Members
448,543
Latest member
MartinLarkin

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