View Full Version : Need help with a complicated Concatenation and Abbreviation Macro
rgrocks
12-22-2015, 10:20 AM
Help I'm working on my very first VBA Macro. I'm trying to figure out how to create a concatenated name but the data isnt very uniform. I took a 6 hour VBA Excel Macro class but I seem to be out of my depth for this.
Currently the code only works on the cell I have highlighted which is fine for my purposes, but something cleaner and more universal might be nice.
My class didnt cover anything like I want to do "/
Attached is a sample data
15022
I want to put three columns (2 of them will be modified) together to form a new name
The names will look like the following examples
&Division&_&CityAbrv&_R&3DigitAssetNo
CC_HST_PH48
SO_HLB_R050
SO_HLB_RR52
SO_WND_R086
ST_JKN_RM03
My Criteria
1) Division is taken straight from the division column
2) CityAbrv needs to be transformed from the "City" Column and abreviated using an attached list of city abreviations on the worksheet "Official City Code"
3) The last 3 characters of the Asset No. The issue with this is that the Asset No. isnt exactly uniform data I want it to take the last 3 characters.
b) if there is a "-" or " " within the last 3 characters, ignore it and dont use it but instead move on to the next charcter to the left for example, DR H 23 should just be H23
4) There is existing data that I dont want to overwrite so this macro needs to only run on the empty cells on the column I'm modifying.
5) Repeat for the remaining blank cells that have data to concatenate
Here is the code I have so far
Sub SCADALocationName()
ActiveCell.FormulaR1C1 = "=CONCATENATE(RC[-3],""_"",RC[-1],""_R"",RIGHT(RC[-2],3))"
End Sub
Please, I understand you may not have the time to help me write it but if you could just point me to the syntax I would need and similar macro's so I could disect it for my purposes. Just point me towards specific lessons and I could try to figure it out. Thanks
mechgod
12-22-2015, 02:45 PM
Just use this A1-style formula in the column for "SCADA Location Name".
=IFERROR(A4&"_"&INDEX('Official City Code'!$A:$A,MATCH(C4,'Official City Code'!$B:$B,0))&"_R"&RIGHT(SUBSTITUTE(TRIM(B4),"-",""),3),"")
You can programmatically enter this formula, but your best bet is to just copy this formula from cell E4 to cell E2 and just use cell E2 as the source cell for copying the formula into your target column.
Use code to copy the formula from cell E2.
[Public Sub Copy_SCADA_Formula()
Dim wks As Worksheet
Set wks = Worksheets("Balnk SCADA")
' your SCADA formula
wks.Range("E2").Copy
' your destination column range
wks.Range("E4:E52").PasteSpecial xlFormulas
Application.CutCopyMode = False
End Sub[/FONT]
Since you are a student, at this point I will only guide you. IF you need specific help, please ask.
It is better to use small simple procedures as "building blocks" rather than one large complex routine.
The main sub I suggest can be easily rewritten into a User Defined Function that can be used in a formula the same way as any Excel Function. (More later)
The Main Sub is for one time use, ie, fill in the blanks. The UDF is for use while developing the spreadsheet, ie, use as a formula in one cell and fill down.
Option Explicit
Sub Main()
Dim RngA As Range
Dim RngB As Range
Dim RngC As Range
Dim rw As Long
Dim Temp As String
With Sheets("Blank SCADA").Columns(4)
For rw = 4 To .Cells(Rows.Count).End(xlUp).Row
If .Cells(rw) = "" Then
Set RngA = .Cells(rw).Offset(, -3)
Set RngB = .Cells(rw).Offset(, -2)
Set RngC = .Cells(rw).Offset(, -1)
Temp = GetDivision(RngA) 'Not strictly needed in this case, but included for completeness and future needs
Temp = Temp & GetAsset(RngB)
If GetCity(RngC) = "NotFound" Then
Temp = "Official City Code not Found"
Else
Temp Temp & GetCity(RngC)
End If
.Cells(rw) = Temp
Temp = ""
End If
Next rw
End With
End Sub
Function GetDiv(DivisionCell As Range) As String
GetDiv = DivisionCell.Value
End Function
Function GetAsset(AssetNoCell As Range) As String
Dim Temp As String
Temp = AssetNoCell.Value
Temp = Replace " ", "" 'See "Replace" in VBA Help
Temp = Replace "-", "" 'See "Replace" in VBA Help
GetAsset = Right(Temp, 3)
End Function
Function GetCity(CityCell As Range) As String
Dim SKADACity As Range
Set SKADACity = Sheets("official City Code").RANGE("BB").Find(Bla Bla Bla 'See "Find" in VBA Help
If SKADACity Is Nothing Then
GetCity = "Not Found"
Else GetCity = '??? 'See "Offset" in VBA Help
End If
End Function
rgrocks
12-22-2015, 10:59 PM
Since you are a student, at this point I will only guide you. IF you need specific help, please ask.
It is better to use small simple procedures as "building blocks" rather than one large complex routine.
The main sub I suggest can be easily rewritten into a User Defined Function that can be used in a formula the same way as any Excel Function. (More later)
The Main Sub is for one time use, ie, fill in the blanks. The UDF is for use while developing the spreadsheet, ie, use as a formula in one cell and fill down.
Option Explicit
Sub Main()
Dim RngA As Range
Dim RngB As Range
Dim RngC As Range
Dim rw As Long
Dim Temp As String
With Sheets("Blank SCADA").Columns(4)
For rw = 4 To .Cells(Rows.Count).End(xlUp).Row
If .Cells(rw) = "" Then
Set RngA = .Cells(rw).Offset(, -3)
Set RngB = .Cells(rw).Offset(, -2)
Set RngC = .Cells(rw).Offset(, -1)
Temp = GetDivision(RngA) 'Not strictly needed in this case, but included for completeness and future needs
Temp = Temp & GetAsset(RngB)
If GetCity(RngC) = "NotFound" Then
Temp = "Official City Code not Found"
Else
Temp Temp & GetCity(RngC)
End If
.Cells(rw) = Temp
Temp = ""
End If
Next rw
End With
End Sub
Function GetDiv(DivisionCell As Range) As String
GetDiv = DivisionCell.Value
End Function
Function GetAsset(AssetNoCell As Range) As String
Dim Temp As String
Temp = AssetNoCell.Value
Temp = Replace " ", "" 'See "Replace" in VBA Help
Temp = Replace "-", "" 'See "Replace" in VBA Help
GetAsset = Right(Temp, 3)
End Function
Function GetCity(CityCell As Range) As String
Dim SKADACity As Range
Set SKADACity = Sheets("official City Code").RANGE("BB").Find(Bla Bla Bla 'See "Find" in VBA Help
If SKADACity Is Nothing Then
GetCity = "Not Found"
Else GetCity = '??? 'See "Offset" in VBA Help
End If
End Function
Thank you so much. I will study the code you laid out so that I can have a more through and complete understanding of VBA. After tinkering and spending time on the internet and other forums, the code that eventually worked for my purposes was the following. Your input looks to be a great basis for me to understand VBA better. Thanks
Sub rgrocks()
Dim lrow As Integer
Dim i As Integer
Dim CCsht As Worksheet
Dim ws As Worksheet
Set CCsht = Sheets("Official City Code")
Set ws = ActiveSheet
lrow = Cells(Rows.Count, 3).End(xlUp).Row
For i = 4 To lrow
If Len(Cells(i, 4)) = 0 Then
If Not IsEmpty(Cells(i, 3)) Then
On Error Resume Next
Cells(i, 4) = Cells(i, 1) & "_" & WorksheetFunction.Index(CCsht.Columns(1), WorksheetFunction.Match(ws.Cells(i, 3), CCsht.Columns(2), 0)) & "_R" & _
Right(WorksheetFunction.Substitute(WorksheetFunction.Substitute(Cells(i, 2), " ", ""), "-", ""), 3)
End If
End If
Next i
End Sub
Sub M_snb()
sn = Sheet3.Cells(1, 2).CurrentRegion
sq = Sheet3.Cells(1, 2).CurrentRegion.Resize(, 1)
sp = Sheet4.Cells(3, 1).CurrentRegion
On Error Resume Next
For j = 2 To UBound(sp)
If sp(j, 4) = "" And sp(j, 1) <> "" Then sp(j, 4) = sp(j, 1) & "_" & sn(Application.Match(sp(j, 3), sq, 0), 2) & "_R" & Right(Replace(Replace(sp(j, 2), " ", ""), ".", ""), 3)
Next
Sheet4.Cells(60, 1).Resize(UBound(sp), UBound(sp, 2)) = sp
End Sub
I will study the code you laid out so that I can have a more through and complete understanding of VBA.
Actually, of the three offerings, mine will show you the least about VBA, but, IMO, the most about programming.
Then one you found by crossposting, requires quite a bit more VBA than mine, and If you really want an in depth knowledge of VBA, try to fully understand exactly what snb's code does. He has a better and deeper understanding of VBA than anybody else I have even heard of, And IMO, that includes Joel Spolsky.
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.