Jak Carty
Jak Carty

Reputation: 57

Concatenate string (VBA) for particular columns

Goal: Add the string "Z" to a select few columns for all rows except the header. Concatenate only on select headers i.e. headers defined in the array.

Dim header As Range
ArrayCheck = Array("CarTime", "BusTime", "PlaneTime")
LastRow = desWS1.Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
lcol = desWS1.Cells(1, Columns.Count).End(xlToLeft).Column

For Each header In desWS1.Range(desWS1.Cells(1, 1), desWS1.Cells(1, lcol))
    For i = LBound(ArrayCheck) To UBound(ArrayCheck)
        If header = ArrayCheck(i) Then
        desWS1.Range(desWS1.Cells(2, header.Column), desWS1.Cells(LastRow, header.Column)) & "Z"
        End If
    Next i
    Next


all entries in these columns are of the form: yyyy-mm-ddThh:mm:ss

Upvotes: 1

Views: 214

Answers (1)

Siddharth Rout
Siddharth Rout

Reputation: 149295

@SiddharthRout the current cell is: 2020-09-07T13:08:46, and the output i want is: 2020-09-07T13:08:46Z. So yep, you're right, it's a string. – Jak Carty 2 mins ago

In my below code, I will take a sample of both date and date stored as text. I have commented the code so you should not have a problem understanding it. But if you do then simply post back.

Is this what you are trying?

Code:

WAY 1

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, lCol As Long
    Dim ArrayCheck As Variant
    Dim i As Long, j As Long
    Dim rng As Range
    
    ArrayCheck = Array("CarTime", "BusTime", "PlaneTime")
    
    '~~> Set this to the relevant worksheet
    Set ws = Sheet1
    
    With ws
        '~~> Find last row
        lRow = .Cells.Find(What:="*", _
               After:=.Range("A1"), _
               Lookat:=xlPart, _
               LookIn:=xlFormulas, _
               SearchOrder:=xlByRows, _
               SearchDirection:=xlPrevious, _
               MatchCase:=False).Row
        
        '~~> Find last col
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        
        '~~> Loop though the cell in 1st row
        For i = 1 To lCol
            '~~> Loop through the array
            For j = LBound(ArrayCheck) To UBound(ArrayCheck)
                '~~> Check if they match
                If .Cells(1, i).Value2 = ArrayCheck(j) Then
                    '~~> Set your range from cell 2 onwards
                    Set rng = .Range(.Cells(2, i), .Cells(lRow, i))
                    
                    '~~> Add "Z" to the entire range in ONE GO i.e without looping
                    '~~> To understand this visit the url below
                    'https://stackoverflow.com/questions/19985895/convert-an-entire-range-to-uppercase-without-looping-through-all-the-cells
                    rng.Value = Evaluate("index(Concatenate(" & rng.Address & ",""Z""" & "),)")
                End If
            Next j
        Next i
    End With
End Sub

Note: For the sake of clarity, I am not joining the string ",""Z""" & "),)")

In Action

enter image description here

WAY 2

Introducing a 2nd way

This code writes to array and then works with it.

Option Explicit

Sub Sample()
    Dim ws As Worksheet
    Dim lRow As Long, lCol As Long
    Dim ArrayCheck As Variant
    Dim i As Long, j As Long, k As Long
    Dim rng As Range
    Dim tmpAr As Variant
    
    ArrayCheck = Array("CarTime", "BusTime", "PlaneTime")
    
    '~~> Set this to the relevant worksheet
    Set ws = Sheet1
    
    With ws
        '~~> Find last row
        lRow = .Cells.Find(What:="*", _
               After:=.Range("A1"), _
               Lookat:=xlPart, _
               LookIn:=xlFormulas, _
               SearchOrder:=xlByRows, _
               SearchDirection:=xlPrevious, _
               MatchCase:=False).Row
        
        '~~> Find last col
        lCol = .Cells(1, .Columns.Count).End(xlToLeft).Column
        
        '~~> Loop though the cell in 1st row
        For i = 1 To lCol
            '~~> Loop through the array
            For j = LBound(ArrayCheck) To UBound(ArrayCheck)
                '~~> Check if they match
                If .Cells(1, i).Value2 = ArrayCheck(j) Then
                    '~> Set your range
                    Set rng = .Range(.Cells(2, i), .Cells(lRow, i))
                    
                    '~~> Store the value in array
                    tmpAr = rng.Value2
                    
                    '~~> Work with array
                    For k = 1 To UBound(tmpAr)
                        tmpAr(k, 1) = tmpAr(k, 1) & "Z"
                    Next k
                    
                    '~~> write the array back to worksheet
                    rng.Resize(UBound(tmpAr), 1).Value = tmpAr
                End If
            Next j
        Next i
    End With
End Sub

In Action

enter image description here

Upvotes: 2

Related Questions