Hi Ingolf,
. A bit late, and you have a working solution but I caught this as a good chance 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!!)…..
. 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";""; |
Code:
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
'Array for string outputs, Redim used as Dim only takes numbers
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()
'
Alan Elston
Dim ilLenDef2 As Integer
Dim llStartLine As Long
Dim llSRow As Long
Dim llSCol As Long
Dim llLine1 As Long
Dim llERow As Long
Dim llECol As Long
Dim llCountLines As Long
Dim ilSanityCheck As Integer
Dim llEndLine As Long
Set olPane = Application.VBE.ActiveCodePane
olPane.GetSelection Startline:=llSRow, startcolumn:=llSCol, Endline:=llERow, Endcolumn:=llECol
slProcName = olPane.CodeModule.ProcOfLine(llSRow, vbext_pk_Proc)
llLine1 = olPane.CodeModule.ProcBodyLine(slProcName, vbext_pk_Proc)
llCountLines = olPane.CodeModule.ProcCountLines(slProcName, vbext_pk_Proc)
llStartLine = olPane.CodeModule.ProcStartLine(slProcName, vbext_pk_Proc)
llEndLine = llStartLine + llCountLines - 1
' Find Dim Line.
llCompLine1 = llLine1
"What's in a String"- VBA break down Loop through character contents of a string
__Hello ( or vbTab & "He" & "l" & "l" & "o" & vbCr & vbLf
In VBA coding an
' Find Dim Line.
llCompLine1 = llLine1
Do
slOLine1 = Trim$(olPane.CodeModule.Lines(llCompLine1, 1))
If Left$(slOLine1, 4) = "Dim " Then
Exit Do
ElseIf Left$(slOLine1, 6) = "Const " Then
"What's in a String"- VBA break down Loop through character contents of a string
"What's in a String"- VBA break down Loop through character contents of a string
__Hello ( or vbTab & "He" & "l" & "l" & "o" & vbCr & vbLf
In VBA coding an
"What's in a String"- VBA break down Loop through character contents of a string
"What's in a String"- VBA break down Loop through character contents of a string
__Hello ( or vbTab & "He" & "l" & "l" & "o" & vbCr & vbLf
In VBA coding an
"What's in a String"- VBA break down Loop through character contents of a string
__Hello ( or vbTab & "He" & "l" & "l" & "o" & vbCr & vbLf
In VBA coding an
"What's in a String"- VBA break down Loop through character contents of a string
__Hello ( or vbTab & "He" & "l" & "l" & "o" & vbCr & vbLf
In VBA coding an
Reply With Quote
Bookmarks