I’ve got a spreadsheet in excel with this rows:
COLUMN Value1.Value2.Value3 Value4.Value5.Value6 Value7.Value8.Value9
In another spreadsheet I’ve got a simple list with names:
COLUMN Name1 Name2 Name3
And,of course, this list is huge :).
So need to have the following spreasdsheet at the end:
COLUMN Value1.Name1.Value2.Value3 Value4.Name1.Value5.Value6 Value7.Name1.Value8.Value9 Value1.Name2.Value2.Value3 Value4.Name2.Value5.Value6 Value7.Name2.Value8.Value9 Value1.Name3.Value2.Value3 Value4.Name4.Value5.Value6 Value7.Name4.Value8.Value9
I have to concatenate the names on the list with all the values on spreadsheet replicating them for ALL the names.
Is there a way of doing this process automatically? The manual process would take hours to be done and I think there’s a smarter way of doing that although I don’t know it! 🙂
Thanks in advance for your help.
There is always a “.” between the values.
Try this code. Using arrays would be much faster for huge list of names/values:
Sub test() Dim arrVal As Variant Dim arrNames As Variant Dim arrRes As Variant Dim v, n, k As Long 'change Sheet1 to suit With ThisWorkbook.Worksheets("Sheet1") 'change A1:A3 to values address arrVal = .Range("A1:A3") 'change B1:B3 to names address arrNames = .Range("B1:B3") ReDim arrRes(1 To UBound(arrVal) * UBound(arrNames), 1 To 1) k = 1 For Each v In arrVal For Each n In arrNames arrRes(k, 1) = Left(v, InStr(1, v, ".")) & n & Mid(v, InStr(1, v, ".")) k = k + 1 Next Next v 'change "c1" to start cell where to put new values .Range("C1").Resize(UBound(arrRes, 1)) = arrRes End With End Sub
If you don’t know exact addresses of “values” and “name” ranges, change this part
'change A1:A3 to values address arrVal = .Range("A1:A3") 'change B1:B3 to names address arrNames = .Range("B1:B3")
'change A1:A to "values" address arrVal = .Range("A1:A" & .Cells(.Rows.Count, "A").End(xlUp).Row) 'change B1:B to "names" address arrNames = .Range("B1:B" & .Cells(.Rows.Count, "B").End(xlUp).Row)
In that case “values” and “name” ranges starts from
B1 accordingly and ends in the last non empty row in coumns
And it is a good challenge to do it with formulas: 🙂
With this array formula in D1 and then copy down
Depending on your regional settings you may need to replace field separator “;” by “,”
I think that could work.
Const FIRST_TALBE = 4 Const SECOND_TABLE = 2 Sub makeTheJob() For i = 1 To lastRow l = Split(Cells(i, FIRST_TABLE), ".") newvalue = l(0) & "." & Cells(i, SECOND_TABLE) & "." & l(1) & "." & l(2) Debug.Print newvalue Next i End Sub