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

Fastest way to copy a worksheet?
Hold down the Ctrl key while dragging tab for Sheet1 to the right. Excel will make a copy of the worksheet.

ask2tsp

Well-known Member
Joined
Feb 18, 2015
Messages
506
Office Version
  1. 365
Platform
  1. Windows
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)

<b></b><table cellpadding="2.5px" rules="all" style=";background-color: #FFFFFF;border: 1px solid;border-collapse: collapse; border-color: #BBB"><colgroup><col width="25px" style="background-color: #DAE7F5" /><col /><col /><col /></colgroup><thead><tr style=" background-color: #DAE7F5;text-align: center;color: #161120"><th></th><th>A</th><th>B</th><th>C</th></tr></thead><tbody><tr ><td style="color: #161120;text-align: center;">1</td><td style="font-weight: bold;border-bottom: 1px solid black;;">import label</td><td style="font-weight: bold;border-bottom: 1px solid black;;">new label</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">2</td><td style="font-weight: bold;text-align: right;border-top: 1px solid black;background-color: #5B9BD5;;"></td><td style="font-weight: bold;text-align: right;border-top: 1px solid black;background-color: #5B9BD5;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">3</td><td style=";">Juridiction Code</td><td style=";">Business Place</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">4</td><td style=";">Juridiction Code Text</td><td style=";">Business Place Des</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">5</td><td style=";">GRN/SE No</td><td style=";">GRN Number</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">6</td><td style=";">GRN/SE Dt</td><td style=";">GRN Date</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">7</td><td style=";">GRN/SE Yr</td><td style=";">GRN Year</td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">8</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr><tr ><td style="color: #161120;text-align: center;">9</td><td style="text-align: right;;"></td><td style="text-align: right;;"></td><td style="text-align: right;;"></td></tr></tbody></table><p style="width:7,2em;font-weight:bold;margin:0;padding:0.2em 0.6em 0.2em 0.5em;border: 1px solid #BBB;border-top:none;text-align: center;background-color: #DAE7F5;color: #161120">labelUpdates</p><br /><br />

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.
 

Culaff

New Member
Joined
Feb 17, 2016
Messages
27
Thank you for that Amazing code ask2tsp. I sincerely appreciate all your help.

Cheers
 

Culaff

New Member
Joined
Feb 17, 2016
Messages
27

ADVERTISEMENT

Hey Ask2tsp,

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

Cheers,
Neal
 

ask2tsp

Well-known Member
Joined
Feb 18, 2015
Messages
506
Office Version
  1. 365
Platform
  1. Windows

ADVERTISEMENT

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.
 

baitmaster

Well-known Member
Joined
Mar 12, 2009
Messages
2,039
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.
 

ask2tsp

Well-known Member
Joined
Feb 18, 2015
Messages
506
Office Version
  1. 365
Platform
  1. Windows
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.
 

Watch MrExcel Video

Forum statistics

Threads
1,129,592
Messages
5,637,290
Members
416,962
Latest member
samfuge

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
Top