Appending a Value to Each Element of a Range Array

bentom

New Member
Joined
Oct 24, 2019
Messages
4
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-ignore:padding; 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.
 

Excel Facts

Easy bullets in Excel
If you have a numeric keypad, press Alt+7 on numeric keypad to type a bullet in Excel.
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


Code:
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
 
Upvote 0
another way ...

Code:
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/
 
Last edited:
Upvote 0
And yet another way...
Code:
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
 
Last edited:
Upvote 0
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.
 
Upvote 0
And yet another way...
Code:
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.
 
Upvote 0
Welcome to the MrExcel board!

Another one to try.

Rich (BB code):
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
 
Upvote 0

Forum statistics

Threads
1,224,820
Messages
6,181,159
Members
453,021
Latest member
Justyna P

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
Back
Top