Appending a Value to Each Element of a Range Array

[bentom]

I have a workbook with 2 sheets: Sheet1 and Sheet2.
In Column A of Sheet1 I have a short uninterrupted list of product IDs:

<style><!--table {mso-displayed-decimal-separator:"\."; mso-displayed-thousand-separator:"\,";}@page {margin:.75in .7in .75in .7in; mso-header-margin:.3in; mso-footer-margin:.3in;}td {padding-top:1px; padding-right:1px; padding-left:1px; mso-ignoreadding; color:black; font-size:12.0pt; font-weight:400; font-style:normal; text-decoration:none; font-family:Calibri, sans-serif; mso-font-charset:0; mso-number-format:General; text-align:general; vertical-align:bottom; border:none; mso-background-source:auto; mso-pattern:auto; mso-protection:locked visible; white-space:nowrap; mso-rotate:0;}.xl63 {mso-number-format:"\@"; border-top:.5pt solid #A9D08E ; border-right:none; border-bottom:.5pt solid #A9D08E ; border-left:.5pt solid #A9D08E ; background:#E2EFDA; mso-pattern:#E2EFDA none;}.xl64 {mso-number-format:"\@"; border-top:.5pt solid #A9D08E ; border-right:none; border-bottom:.5pt solid #A9D08E ; border-left:.5pt solid #A9D08E ;}--></style>[TABLE="width: 87"]
<tbody>[TR]
[TD="class: xl63, width: 87"]26109179[/TD]
[/TR]
[TR]
[TD="class: xl64"]20346713[/TD]
[/TR]
[TR]
[TD="class: xl63"]26113399[/TD]
[/TR]
[TR]
[TD="class: xl64"]20306639[/TD]
[/TR]
[TR]
[TD="class: xl63"]26115634[/TD]
[/TR]
</tbody>[/TABLE]

I copy this list to an array with the aim of transforming it and pasting it into Sheet2. There are various things that I need to do, but the first step is to append a 4 digit code, like 6030, to the end of each element value e.g. DirArray(0) becomes 261091796030. However each time, I am get type mismatch errors. If I try to access each element in a for loop I get an out of bounds error. I am beginning to think this is not possible to do. The code below works in so far as to copy the data in Sheet1 to Sheet2 - I just need to transform the array so at the point I paste into Sheet2 they are updated values.

<style type="text/css">p.p1 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000000 ; background-color: #ffffff }p.p2 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; color: #000080 ; background-color: #ffffff }p.p3 {margin: 0.0px 0.0px 0.0px 0.0px; font: 11.0px Menlo; background-color: #ffffff ; min-height: 13.0px}span.s1 {color: #000080 }span.s2 {color: #000000 }</style> Dim StartCell As Range
Dim DirArray As Variant
Dim i As Integer


Sheets("Sheet1").Select
Set StartCell = Range("A1")
StartCell.CurrentRegion.Select


DirArray = StartCell.CurrentRegion.Value

Sheets("Sheet2").Select

'At this point I want to append "6030" to the END of each element value in DirArray

ActiveSheet.Range(Cells(2, 2), Cells(UBound(DirArray) + 1, 2)) = DirArray



Can anyone please help me? Thanks in anticipation.

 

[Yongle]

One way
- note that no sheets or cells are selected
- selection slows down the code and can make it more tricky to amend the code
- use variables and always qualify ranges with sheet reference etc

Sub bentom()
    Const append = "6030"
    Dim A, B() As String
    Dim x As Integer, u As Integer, dest As Worksheet

    Set dest = Sheets("Sheet2")
    A = Sheets("Sheet1").Range("A1").CurrentRegion.Value
    u = UBound(A)
    ReDim B(1 To u, 1)
[COLOR=#006400] 'create array of appended values[/COLOR]
    For x = 1 To u
        B(x, 1) = A(x, 1) & append
    Next x
[COLOR=#006400]'format destination[/COLOR]
    Application.ScreenUpdating = False
    With dest.Columns("B")
        .ColumnWidth = 15
        .NumberFormat = "0"                [COLOR=#006400] 'prevents scientific notation[/COLOR]
    End With
[COLOR=#006400]'write values to sheet[/COLOR]
    For x = 1 To u
        Sheets("Sheet2").Cells(x + 1, 2) = B(x, 1)
    Next x
End Sub

 

[Yongle]

another way ...

Sub bentom2()
    Const append = "6030"
    Dim A, x As Integer, u As Integer

    A = Sheets("Sheet1").Range("A1").CurrentRegion.Value
    u = UBound(A)
    ReDim B(1 To u, 1)
[COLOR=#006400] 'create array of appended values[/COLOR]
    For x = 1 To u
        A(x, 1) = A(x, 1) & append
    Next x
[COLOR=#006400]'format destination and write values to sheet[/COLOR]
    Application.ScreenUpdating = False
    With Sheets("Sheet2")
        .Columns("B").ColumnWidth = 15
        .Columns("B").NumberFormat = "0"                 [COLOR=#006400]'prevents scientific notation[/COLOR]
        .Cells(2, 2).Resize(u).Value = A
    End With
End Sub

and some bedtime reading for you
https://excelmacromastery.com/excel-vba-array/

 

[Rick Rothstein]

And yet another way...

Sub Append6030()
  Dim Arr As Variant
  Arr = Application.Transpose(Split(Replace(Join(Application.Transpose(Sheets("Sheet1").Range("A1").CurrentRegion), vbLf), vbLf, 6030 & vbLf) & 6030, vbLf))
  Sheets("Sheet2").Range("A1").Resize(UBound(Arr)).NumberFormat = "@"
  Sheets("Sheet2").Range("A1").Resize(UBound(Arr)) = Arr
End Sub

 

[bentom]

Thank you very much Yongle. I clearly need that bedtime reading.

Thank you again.

 

[bentom]

Wow - that's neat. Will compare with all the solutions to see which is fastest as there will be a fair amount of data to crunch. Thank you for this elegant response.

 

[bentom]

And yet another way...

Sub Append6030()
  Dim Arr As Variant
  Arr = Application.Transpose(Split(Replace(Join(Application.Transpose(Sheets("Sheet1").Range("A1").CurrentRegion), vbLf), vbLf, 6030 & vbLf) & 6030, vbLf))
  Sheets("Sheet2").Range("A1").Resize(UBound(Arr)).NumberFormat = "@"
  Sheets("Sheet2").Range("A1").Resize(UBound(Arr)) = Arr
End Sub

one thing though - i was having major problems with application.transpose as it was only repeating the first element in the array. I'm not sure what you've done to overcome this bug in Excel.

 

[Peter_SSs]

Welcome to the MrExcel board!

Another one to try.

Sub Append_6030()
  With Sheets("Sheet2").Range("B2").Resize(Sheets("Sheet1").Range("A1").CurrentRegion.Rows.Count)
    .NumberFormat = "0"
    .Value = Evaluate("Sheet1!" & .Offset(-1, -1).Address & "&""6030""")
  End With
End Sub