Special concatenation

**Ingolf** · 08-02-2015, 07:47 PM

Goog Day,

Need some help for some special concatenation.

ConCatSpecial.jpg

The date look like:
AA NAME CC DD EE FF GG HH1
1 BEER 1 0 1 1 1
2 VODCA 1 0 1 1 1
3 COGNAC 1 0 1 1 1
4 WHISKY 1 0 1 1 1

and need a VBA cod to do this:

1;"BEER";"1";"0.00";"1";"1";"1";"";
2;"VODCA";"1";"0.00";"1";"1";"1";"";
3;"COGNAC";"1";"0.00";"1";"1";"1";"";
4;"WHISKY";"1";"0.00";"1";"1";"1";"";

in other sheet.
Thank you.

**Rick Rothstein** · 08-02-2015, 10:41 PM

Because this forum's comment processor "eats" multiple spaces, it is hard to tell what columns your original data is in. When I copy/paste it into a worksheet, the column labeled HH1 is empty. Is it possible for there to be blank cells within the data... for example, could cells C2, D2, F2, G2 with E2 and H2 being empty, or will all filled cells always be contiguous across the row?

**Ingolf** · 08-03-2015, 12:20 AM

Thanks for the reply guru Rick,

Indeed column H is very often empty. Therefore I need to defend this sign "" (double quote).
It is not possible to Cn, Dn, En, Fn, and Gn to be empty. And if there are empty rows means that no longer of interest. The cells can be only 0 or a positive number ...

Usual I have between 2000 to 7000 rows.

Thank you

**Rick Rothstein** · 08-03-2015, 05:34 AM

There was a minor discrepancy in the output between what you posted in Message #1 and what you showed in on Sheet2 of the file you attached for the fourth field... Message #1 shows the fourth field as being formatted as number with two decimal places whereas your file shows you want that field to be a 3-digit whole number with leading zeroes. I assume Message #1 was correct; here is a macro for you to consider (I assumed sheets named Sheet1 and Sheet2 like you showed in the file you attached)...

Code:

Sub Booze()
  Dim R As Long, Data As Variant, Results As Variant
  Data = Sheets("Sheet1").Range("A2:H" & Sheets("Sheet1").Cells(Rows.Count, "A").End(xlUp).row)
  ReDim Results(1 To UBound(Data), 1 To 1)
  For R = 1 To UBound(Data)
    Data(R, 4) = Format(Data(R, 4), "0.00")
    Results(R, 1) = Join(Application.Index(Data, R, Split("1 2 3 4 5 6 7 8")), """;""")
    Results(R, 1) = Replace(Results(R, 1), """", "", , 1) & """;"
  Next
  Sheets("Sheet2").Range("A1").Resize(UBound(Results)) = Results
End Sub

**Ingolf** · 08-03-2015, 11:59 AM

Extraordinary, excellent

Yes, message #1 was correct.

Rick you are the best of the best.

Thank you very much.

**snb** · 08-11-2015, 12:52 PM

another approach:

Code:

Sub M_snb()
  Sheet1.UsedRange.Offset(1).Copy
  With GetObject("New:{1C3B4210-F441-11CE-B9EA-00AA006B1A69}")
    .GetFromClipboard
    sn = Filter(Split(Replace(Replace(Replace(.GetText, vbTab, Chr(34) & ";" & Chr(34)), ";" & Chr(34) & vbCrLf, "|" & Chr(34)), vbLf, Chr(34) & "|" & Chr(34)), "|"), ";")
  End With

  Sheet2.Cells(1).Resize(UBound(sn) + 1) = Application.Transpose(sn)
End Sub

**Ingolf** · 08-11-2015, 06:13 PM

snb, thanks for reply

Result of VBA cod sould be;

1;"BEER";"1";"0,00";"1";"1";"1";"";
2;"VODCA";"1";"0,00";"1";"1";"1";"";
3;"COGNAC";"1";"0,00";"1";"1";"1";"";
4;"WHISKY";"1";"0,00";"1";"1";"1";"";
5;"BEER";"1";"0,00";"1";"1";"1";"";

Your VBA cod result is:
1";"BEER";"1";"0";"1";"1";"1";"";
"2";"VODCA";"1";"0";"1";"1";"1";"";
"3";"COGNAC";"1";"0";"1";"1";"1"
"4";"WHISKY";"1";"0";"1";"1";"1"
"5";"BEER";"1";"0";"1";"1";"1"

left numbers should not be surrounded by quotation marks.
If in the seventh column is not a number, must be empty quotation marks (""). I add to first 2 line (in red)
After last number must be ";" (without quotation marks)
It must be like result of Rick VBA code.
Can you fix it? Thanks.

**DocAElstein** · 08-30-2015, 03:28 AM

Hi Ingolf,
. A bit late, and you have a working solution but I caught this as a good chance to practice my “Quote in Evaluate String” Stuff. Something I have to practice to get right since I have been struggling a year to understand and still can’t quite understand it..
. Anyways, this code alternative, I think will also work for you. _ It gives by me exactly the same results as Rick’s, which is a good sign ( and most of these sort of codes I have from his Threads anyways.. )
. Note, you will need to put your zeros in the cell as 0.00 and format it as text for my code to work ( Rick’s work’s without that , but that is what you would expect!!)…..

Your input for a few rows
Using Excel 2007

_Row\^Col	A	B	C	D	E	F	G	H
1	AA	NAME	CC	DD	EE	FF	GG	HH
2	1	BEER	1	0.00	1	1	1
3	2	VODCA	1	0.00	1	1	1
4	3	COGNAC	1	0.00	1	1	1

Sheet1

......
. My typical output for a few rows….

Using Excel 2007

_Row\^Col	A
1	1;"BEER";"1";"0.00";"1";"1";"1";"";
2	2;"VODCA";"1";"0.00";"1";"1";"1";"";
3	3;"COGNAC";"1";"0.00";"1";"1";"1";"";
4	4;"WHISKY";"1";"0.00";"1";"1";"1";"";
5	5;"BEER";"1";"0.00";"1";"1";"1";"";
6	6;"VODCA";"1";"0.00";"1";"1";"1";"";
7	7;"COGNAC";"1";"0.00";"1";"1";"1";"";

Sheet2

Code:

'
Sub IngolfBoozeConcatenatingQoutyStuff() 'http://www.excelfox.com/forum/f2/special-concatenation-2042/
'Worksheet info
Dim ws1 As Worksheet: Set ws1 = ThisWorkbook.Worksheets("Sheet1") 'Sheet Info
Dim ws2 As Worksheet: Set ws2 = ThisWorkbook.Worksheets("Sheet2")
Dim lr As Long: Let lr = ws1.Cells(Rows.Count, 2).End(xlUp).Row 'The Range Object ( cell ) that is the last cell  in the column of interest has the property .End ( argument Xl up ) appisd to it. This returns a new range ( cell ) which is that of the first Range ( cell ) with something in it "looking up" the XL spreadsheet from the last cell. Then the .Row Property is applied to return a long number equal to the row number of that cell. +1 gives the next free cell.    ( Long is a Big whole Number limit (-2,147,483,648 to 2,147,483,647) If you need some sort of validation the value should only be within the range of a Byte/Integer otherwise there's no point using anything but Long.--upon/after 32-bit, Integers (Short) need converted internally anyways, so a Long is actually faster. )
Dim lc As Long: Let lc = ws1.Cells.Find(What:="*", After:=ws1.Cells(1, 1), lookat:=xlPart, LookIn:=xlFormulas, searchorder:=xlByColumns, searchdirection:=xlPrevious).Column 'Get last Row with entry anywhere for Sheet1. Method: You start at last cell then go backwards, effectively starting at last column ( allowing for different XL versions ) searching for anything ( = * ) by columns then get the column number
 
'Range Info
Dim rngA As Range: Set rngA = ws2.Range("A1:A" & lr - 1 & "") 'Output Range
rngA.ClearContents 'Just so I know the conctnating lines work!!
 
'String argument for Evaluate "One Liner
Dim Evalstr As String
Dim c As Long, r As Long 'Columns, 'Rows in Sheet
'Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, 1), ws1.Cells(lr, 1)).Address & "" & "&"";" & """" & """&" 'DON'T WORK !!!
Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, 1), ws1.Cells(lr, 1)).Address & "" & "&"";""""""&" 'Concatenate cell values with  ; inbetween
    For c = 2 To lc - 1 Step 1 '
    Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, c), ws1.Cells(lr, c)).Address & "" & "&"""""";""""""&" 'Concatenate cell values with  ; inbetween
    Next c
Let Evalstr = Evalstr & "" & ws1.Range(ws1.Cells(2, lc), ws1.Cells(lr, lc)).Address & "" & "&"""""";"""  'Concatenate last row ( usually .Address & ""  -  without any  ;
 
Let Evalstr = Replace(Evalstr, "$", "") 'Get rid of $. Not too important here but can help in keeping <255 for longer Strings
 
Let rngA.Value = Evaluate(Evalstr)
MsgBox ("I have """"Done" & """" & " It") '!? But why DONT " & """" & " WORK in me Evaluate String like it does in the Msgbox string?????
End Sub 'IngolfBoozeConcatenatingQoutyStuff()
'