Concatenate Multiple Cells

[pawcoyote]

Howdy, I have the below that has worked for me in the past (Had to run a Macro). But I am trying to clean it up and add if it doesn't have the info it leaves it blank. I would also like it to run when you enter the info into the State field automatically.

If I enter a State in cell Y3 it will concatenate cells Y, X, W, AB and AC into Cell CE. If it doesn't have any info in the cell is leaves it blank.


Sub SiteReference()
Dim lngLastRow As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'Uses Column A to set the 'lngLastRow' variable _(find the last row) - change if required.
lngLastRow = Cells(Rows.Count, "A").End(xlUp).Row
Range("CE3:CE" & lngLastRow).Value = Evaluate("=Y3:Y" & lngLastRow & "&""--""&" & "X3:X" & lngLastRow & "&""--""&" & "W3:W" & lngLastRow & "&""--""&" & "AB3:AB" & lngLastRow & "&""--""&" & "AC3:AC" & lngLastRow)
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub


I had someone try to help me but the below isn't working it is missing 3 of the cells to concatenate.



Sub ConCat()
With Range("Y3", Range("Y" & Rows.Count).End(xlUp))
.Offset(, 58).Value = Evaluate("if(" & .Address & "="""",""""," & .Address & "& ""_"" & " & .Offset(, 2).Address & ")")
End With
End Sub

[Paul_Hossler]

Slight addition to your other post



Option Explicit

Const cStreetCol As Long = 23
Const cCityCol As Long = 24
Const cStateCol As Long = 25
Const cRegionCol As Long = 30
Const cFloorCol As Long = 28
Const cRoomCol As Long = 29
Const cOracleSiteCol As Long = 83

Dim rNames As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rStates As Range, rState As Range
Dim v As Variant

If Intersect(Target, Me.Columns(cStateCol)) Is Nothing Then Exit Sub

Set rStates = Intersect(Target, Me.Columns(cStateCol))
Set rNames = Worksheets("Names").Range("J:K")

Application.EnableEvents = False
For Each rState In rStates.Cells
With rState
If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

Else
On Error Resume Next
v = Application.WorksheetFunction.VLookup(.Value, rNames, 2, False)
On Error GoTo 0

If IsEmpty(v) Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = vbRed
.EntireRow.Cells(cOracleSiteCol).ClearContents
Else
.EntireRow.Cells(cRegionCol).Value = v
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

'If I enter a State in cell Y3 it will concatenate cells Y, X, W, AB and AC into Cell CE.
' If it doesn't have any info in the cell is leaves it blank.
.EntireRow.Cells(cOracleSiteCol).Value = _
.EntireRow.Cells(cStateCol).Value & " " & _
.EntireRow.Cells(cCityCol).Value & " " & _
.EntireRow.Cells(cStreetCol).Value & " " & _
.EntireRow.Cells(cFloorCol).Value & " " & _
.EntireRow.Cells(cRoomCol).Value
End If
End If
End With
Next

Application.EnableEvents = True
End Sub

[pawcoyote]

That works great except if I delete the State it doesn't reset the field to blank... It leaves the last info in there...

[pawcoyote]

Hi, it works great except when you delete the State it doesn't reset the Site Reference to blank. It leaves the last filled in info.. Thanks for all your help Paul.


Slight addition to your other post



Option Explicit

Const cStreetCol As Long = 23
Const cCityCol As Long = 24
Const cStateCol As Long = 25
Const cRegionCol As Long = 30
Const cFloorCol As Long = 28
Const cRoomCol As Long = 29
Const cOracleSiteCol As Long = 83

Dim rNames As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rStates As Range, rState As Range
Dim v As Variant

If Intersect(Target, Me.Columns(cStateCol)) Is Nothing Then Exit Sub

Set rStates = Intersect(Target, Me.Columns(cStateCol))
Set rNames = Worksheets("Names").Range("J:K")

Application.EnableEvents = False
For Each rState In rStates.Cells
With rState
If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

Else
On Error Resume Next
v = Application.WorksheetFunction.VLookup(.Value, rNames, 2, False)
On Error GoTo 0

If IsEmpty(v) Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = vbRed
.EntireRow.Cells(cOracleSiteCol).ClearContents
Else
.EntireRow.Cells(cRegionCol).Value = v
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

'If I enter a State in cell Y3 it will concatenate cells Y, X, W, AB and AC into Cell CE.
' If it doesn't have any info in the cell is leaves it blank.
.EntireRow.Cells(cOracleSiteCol).Value = _
.EntireRow.Cells(cStateCol).Value & " " & _
.EntireRow.Cells(cCityCol).Value & " " & _
.EntireRow.Cells(cStreetCol).Value & " " & _
.EntireRow.Cells(cFloorCol).Value & " " & _
.EntireRow.Cells(cRoomCol).Value
End If
End If
End With
Next

Application.EnableEvents = True
End Sub

[Paul_Hossler]

If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cOracleSiteCol).ClearContents ' <<<<<<<<<<<<<<<<<<<<<<
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone
Else

[pawcoyote]

Gotcha now, same code just apply it to the different columns. Thanks for the help, I am learning a ton.




If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cOracleSiteCol).ClearContents ' <<<<<<<<<<<<<<<<<<<<<<
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone
Else

[Paul_Hossler]

Thanks for the help, I am learning a ton.


Good, 'cause the next easy one is up to you :devil2:

If you get stuck on something, come on back

[pawcoyote]

Paul, I had to make a change to my spread sheet and add in more rows before the data is being entered.

The Heading for the column is now in Row 5 The Data doesn't start until Row 7 now...

The Columns have stayed the same. I was hoping that this was dynamic and would change with the adding or removal of Rows or Columns...

i.e.

Y5 = State Header
Y7 = State Entered

etc... All the Columns have stayed the same just new rows were added... Thanks for any guidance.

I added the sample file


Slight addition to your other post



Option Explicit

Const cStreetCol As Long = 23
Const cCityCol As Long = 24
Const cStateCol As Long = 25
Const cRegionCol As Long = 30
Const cFloorCol As Long = 28
Const cRoomCol As Long = 29
Const cOracleSiteCol As Long = 83

Dim rNames As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rStates As Range, rState As Range
Dim v As Variant

If Intersect(Target, Me.Columns(cStateCol)) Is Nothing Then Exit Sub

Set rStates = Intersect(Target, Me.Columns(cStateCol))
Set rNames = Worksheets("Names").Range("J:K")

Application.EnableEvents = False
For Each rState In rStates.Cells
With rState
If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

Else
On Error Resume Next
v = Application.WorksheetFunction.VLookup(.Value, rNames, 2, False)
On Error GoTo 0

If IsEmpty(v) Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = vbRed
.EntireRow.Cells(cOracleSiteCol).ClearContents
Else
.EntireRow.Cells(cRegionCol).Value = v
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

'If I enter a State in cell Y3 it will concatenate cells Y, X, W, AB and AC into Cell CE.
' If it doesn't have any info in the cell is leaves it blank.
.EntireRow.Cells(cOracleSiteCol).Value = _
.EntireRow.Cells(cStateCol).Value & " " & _
.EntireRow.Cells(cCityCol).Value & " " & _
.EntireRow.Cells(cStreetCol).Value & " " & _
.EntireRow.Cells(cFloorCol).Value & " " & _
.EntireRow.Cells(cRoomCol).Value
End If
End If
End With
Next

Application.EnableEvents = True
End Sub

[Paul_Hossler]

It's possible to search column headers to find the right column, but for static data I just put the column number into an easily found Const:




Const cStreetCol As Long = 23
Const cCityCol As Long = 24
Const cStateCol As Long = 25
Const cRegionCol As Long = 30
Const cFloorCol As Long = 28
Const cRoomCol As Long = 29
Const cOracleSiteCol As Long = 83



2. You attached Sample_1 which was not the latest, so here's Sample_5


3. Row 7 or greater check added



Option Explicit

Const cStreetCol As Long = 23
Const cCityCol As Long = 24
Const cStateCol As Long = 25
Const cRegionCol As Long = 30
Const cFloorCol As Long = 28
Const cRoomCol As Long = 29
Const cOracleSiteCol As Long = 83

Dim rNames As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rStates As Range, rState As Range
Dim v As Variant

If Intersect(Target, Me.Columns(cStateCol)) Is Nothing Then Exit Sub

Set rStates = Intersect(Target, Me.Columns(cStateCol))
Set rNames = Worksheets("Names").Range("J:K")

Application.EnableEvents = False
For Each rState In rStates.Cells
With rState
If .Row < 7 Then GoTo NextRow

If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

Else
On Error Resume Next
v = Application.WorksheetFunction.VLookup(.Value, rNames, 2, False)
On Error GoTo 0

If IsEmpty(v) Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = vbRed
.EntireRow.Cells(cOracleSiteCol).ClearContents
Else
.EntireRow.Cells(cRegionCol).Value = v
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

'If I enter a State in cell Y3 it will concatenate cells Y, X, W, AB and AC into Cell CE.
' If it doesn't have any info in the cell is leaves it blank.
.EntireRow.Cells(cOracleSiteCol).Value = _
.EntireRow.Cells(cStateCol).Value & " " & _
.EntireRow.Cells(cCityCol).Value & " " & _
.EntireRow.Cells(cStreetCol).Value & " " & _
.EntireRow.Cells(cFloorCol).Value & " " & _
.EntireRow.Cells(cRoomCol).Value
End If
End If
End With

NextRow:
Next

Application.EnableEvents = True
End Sub

[pawcoyote]

I will check it out... Again thanks for the help!

[pawcoyote]

I added in the extra lines as indicated... But it's not working..

Option ExplicitPrivate Sub Worksheet_Change(ByVal Target As Range)
'When a State is entered in Y7 on the "MDS Equipment Detail" tab this section will match up the Region to that State.
'When a State is entered in Y7 on the "MDS Equipment Detail" tab the site reference cell will be filled in.


Const cStreetCol As Long = 23
Const cCityCol As Long = 24
Const cStateCol As Long = 25
Const cRegionCol As Long = 30
Const cFloorCol As Long = 28
Const cRoomCol As Long = 29
Const cOracleSiteCol As Long = 83


'Delcare the target Ranges
Dim rNames As Range

Dim rStates As Range, rState As Range
Dim v As Variant

If Intersect(Target, Me.Columns(cStateCol)) Is Nothing Then Exit Sub

Set rStates = Intersect(Target, Me.Columns(cStateCol))
Set rNames = Worksheets("Names").Range("J:K")

Application.EnableEvents = False
For Each rState In rStates.Cells
With rState
If .Row < 7 Then GoTo NextRow
If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cOracleSiteCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

Else
On Error Resume Next
v = Application.WorksheetFunction.VLookup(.Value, rNames, 2, False)
On Error GoTo 0

If IsEmpty(v) Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = vbRed
.EntireRow.Cells(cOracleSiteCol).ClearContents
Else
.EntireRow.Cells(cRegionCol).Value = v
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

'If I enter a State in cell Y7 it will concatenate cells Y, X, W, AB and AC into Cell CE.
' If it doesn't have any info in the cell is leaves it blank.
.EntireRow.Cells(cOracleSiteCol).Value = _
.EntireRow.Cells(cStateCol).Value & " " & _
.EntireRow.Cells(cCityCol).Value & " " & _
.EntireRow.Cells(cStreetCol).Value & " " & _
.EntireRow.Cells(cFloorCol).Value & " " & _
.EntireRow.Cells(cRoomCol).Value
End If
End If
End With
NextRow:
Next

Application.EnableEvents = True
End Sub



It's possible to search column headers to find the right column, but for static data I just put the column number into an easily found Const:




Const cStreetCol As Long = 23
Const cCityCol As Long = 24
Const cStateCol As Long = 25
Const cRegionCol As Long = 30
Const cFloorCol As Long = 28
Const cRoomCol As Long = 29
Const cOracleSiteCol As Long = 83



2. You attached Sample_1 which was not the latest, so here's Sample_5


3. Row 7 or greater check added



Option Explicit

Const cStreetCol As Long = 23
Const cCityCol As Long = 24
Const cStateCol As Long = 25
Const cRegionCol As Long = 30
Const cFloorCol As Long = 28
Const cRoomCol As Long = 29
Const cOracleSiteCol As Long = 83

Dim rNames As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rStates As Range, rState As Range
Dim v As Variant

If Intersect(Target, Me.Columns(cStateCol)) Is Nothing Then Exit Sub

Set rStates = Intersect(Target, Me.Columns(cStateCol))
Set rNames = Worksheets("Names").Range("J:K")

Application.EnableEvents = False
For Each rState In rStates.Cells
With rState
If .Row < 7 Then GoTo NextRow

If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

Else
On Error Resume Next
v = Application.WorksheetFunction.VLookup(.Value, rNames, 2, False)
On Error GoTo 0

If IsEmpty(v) Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = vbRed
.EntireRow.Cells(cOracleSiteCol).ClearContents
Else
.EntireRow.Cells(cRegionCol).Value = v
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

'If I enter a State in cell Y3 it will concatenate cells Y, X, W, AB and AC into Cell CE.
' If it doesn't have any info in the cell is leaves it blank.
.EntireRow.Cells(cOracleSiteCol).Value = _
.EntireRow.Cells(cStateCol).Value & " " & _
.EntireRow.Cells(cCityCol).Value & " " & _
.EntireRow.Cells(cStreetCol).Value & " " & _
.EntireRow.Cells(cFloorCol).Value & " " & _
.EntireRow.Cells(cRoomCol).Value
End If
End If
End With

NextRow:
Next

Application.EnableEvents = True
End Sub

[pawcoyote]

Got it to work, I need to look into how to covert to looking at the Row Headers but I know that is possibly a lot of work..

[Paul_Hossler]

Not much work.

I don't use this a lot since it is so dependent on the correct spelling of the column headers. A <space> in the wrong place is enough to not find the column header




Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rStates As Range, rState As Range
Dim v As Variant

Dim colStreet As Long
Dim colCity As Long
Dim colState As Long
Dim colRegion As Long
Dim colFloor As Long
Dim colRoom As Long
Dim colOracleSite As Long

Dim rNames As Range

On Error GoTo ColumnNotFound
With Application.WorksheetFunction
colStreet = .Match("Location Street Address", Me.Rows(5), 0)
colCity = .Match("Location City", Me.Rows(5), 0)
colState = .Match("Location State", Me.Rows(5), 0)
colRegion = .Match("Region", Me.Rows(5), 0)
colFloor = .Match("Floor", Me.Rows(5), 0)
colRoom = .Match("Room", Me.Rows(5), 0)
colOracleSite = .Match("Oracle Site Reference (custom14)", Me.Rows(5), 0)
End With
On Error GoTo 0


If Intersect(Target, Me.Columns(colState)) Is Nothing Then Exit Sub

Set rStates = Intersect(Target, Me.Columns(colState))
Set rNames = Worksheets("Names").Range("J:K")

Application.EnableEvents = False
For Each rState In rStates.Cells
With rState
If .Row < 7 Then GoTo NextRow

If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(colRegion).ClearContents
.EntireRow.Cells(colRegion).Interior.Color = xlNone

Else
On Error Resume Next
v = Application.WorksheetFunction.VLookup(.Value, rNames, 2, False)
On Error GoTo 0

If IsEmpty(v) Then
.EntireRow.Cells(colRegion).ClearContents
.EntireRow.Cells(colRegion).Interior.Color = vbRed
.EntireRow.Cells(colOracleSite).ClearContents
Else
.EntireRow.Cells(colRegion).Value = v
.EntireRow.Cells(colRegion).Interior.Color = xlNone

'If I enter a State in cell Y3 it will concatenate cells Y, X, W, AB and AC into Cell CE.
' If it doesn't have any info in the cell is leaves it blank.
.EntireRow.Cells(colOracleSite).Value = _
.EntireRow.Cells(colState).Value & " " & _
.EntireRow.Cells(colCity).Value & " " & _
.EntireRow.Cells(colStreet).Value & " " & _
.EntireRow.Cells(colFloor).Value & " " & _
.EntireRow.Cells(colRoom).Value
End If
End If
End With
NextRow:
Next

Application.EnableEvents = True

Exit Sub

ColumnNotFound:
MsgBox "Column not found"
End Sub

[pawcoyote]

Thank you Paul, totally understand... quick question which is the best way to do this for processing by how you originally helped me create this or would the "Match" to the name be faster and more efficient?

[pawcoyote]

Paul, I have another one for you... I want to copy the Version Numbers from the Version Notes Tab to different areas on the Cover Page and MDS Equipment Detail Tabs.. Here is what I created but it is not placing the version number in the areas I indicated.


Private Sub Worksheet_Change(ByVal Target As Range)Application.EnableEvents = False
If Target.Column = 1 Then
Dim latest As String
Dim lrow As Integer
lrow = ThisWorkbook.Worksheets("Version Notes").Range("A" & Rows.Count).End(xlUp).Row
latest = ThisWorkbook.Worksheets("Version Notes").Range("A" & lrow).Value
ThisWorkbook.Worksheets("MDS Equipment Detail").Range("C3").Value = latest
ThisWorkbook.Worksheets("Cover Page").Range("D1").Value = latest
End If
Application.EnableEvents = True


End Sub


Private Sub Worksheet_SelectionChange(ByVal Target As Range)


End Sub

[Paul_Hossler]

6 of 1
.5 dozen of other

Performance differences would be imperceptible

Depends if you're the only one using it

Alt 1 - Match allows adding, deleting, and re-arranging columns without having to change the macro, unless one of the critical columns is changed since it looks for a specific string.

Alt 2 - Requires the columns to be in the proper place.

If it were me and others would be using it, I'd lock selected cell, format the sheet, and protect the worksheet to keeps it 'safe'

[pawcoyote]

I figured it out... I removed the ThisWorkbook. and it worked..

[pawcoyote]

Roger and thank you. Yes once all is said and done it will be protected and locked.
6 of 1
.5 dozen of other

Performance differences would be imperceptible

Depends if you're the only one using it

Alt 1 - Match allows adding, deleting, and re-arranging columns without having to change the macro, unless one of the critical columns is changed since it looks for a specific string.

Alt 2 - Requires the columns to be in the proper place.

If it were me and others would be using it, I'd lock selected cell, format the sheet, and protect the worksheet to keeps it 'safe'

[Paul_Hossler]

Paul, I have another one for you... I want to copy the Version Numbers from the Version Notes Tab to different areas on the Cover Page and MDS Equipment Detail Tabs.. Here is what I created but it is not placing the version number in the areas I indicated.

Yes it is

Your code in in the 'Worksheet_Change' event handler for the Version Notes worksheet, so it only runs when there is a change to something in column 1 on that sheet

I added a version 1.0.0.4 line to the Version Notes sheet and it went where you wanted

However, you might use a WS formula in those cells

=INDEX('Version Notes'!$A:$A,COUNTA('Version Notes'!$A:$A),1)


so that it gets picked up automatically without relying on Version Notes being updated

[pawcoyote]

Thank you very much.