Editor Formating Test

[DocAElstein]

--General Settings -- Miscellaneous Options -- Message Editor Interface -- . Enhanced Interface - Full WYSIWYG Editing


….in … IE9 browser….. (right mouse click insert ( copied from WORD )

X x x x x x x x x x x xx x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x
x x x x x x x x x x x xx x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x xx x x x x x x x

[DocAElstein]

--General Settings -- Miscellaneous Options -- Message Editor Interface -- . Standard Editor - Extra formatting controls

….in … IE9 browser….. (right mouse click insert ( Copied from WORD ))

X x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x
x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x

[DocAElstein]

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";"";

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
 
'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

[DocAElstein]

Or:

Sub M_snb()
  Sheet1.UsedRange.Columns(4).NumberFormat = "0.00"
  Sheet1.UsedRange.Offset(1).Copy
  .......

Ahh, interesting that formatting the cell like that works with yoouur "Clipboard method"
. I tried versions of that with mine and fell down - I guess because I am "evaluating stuff" and then so getting a 0. You are copying and pasting.
. But you inspired me to take another look, and got it in the end:

... this bit did the trick:

'Attempting to get 0.00 format
'ws1.UsedRange.Columns(4).NumberFormat = "0.00" 'Don't Work
ws1.Range("D2:D" & lr & "").NumberFormat = "@"
ws1.Range("D2:D" & lr & "").Value2 = "0.00"

…………………………………………

Sub IngolfBoozeConcatenatingQoutyStuff() ' Post #16 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!!
 
 
'Attemping to geet 0.00 format
'ws1.UsedRange.Columns(4).NumberFormat = "0.00" 'Don't Work
ws1.Range("D2:D" & lr & "").NumberFormat = "@"
ws1.Range("D2:D" & lr & "").Value2 = "0.00"
 
'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()

Thanks for coming back, Snub and encouraging me to get it right, and understand why
Alan

[Kyle]

'
'
Sub IndexMaker()
Rem 1 Arbeitsblätter Info. und Haupt Variablen
Dim vTemp As Variant 'Evtl. benutz im Debugging
Dim wsIn As Worksheet, wsOutIn As Worksheet 'Dieses variablen definieret als Objekte Arbeitsblätter ( Worksheets)
Set wsIn = ThisWorkbook.Worksheets("Index"): Set wsOutIn = ThisWorkbook.Worksheets("Output") 'Gibt die verkürzen Buchstaben im Code Methoden, Eigenschaften usw. von Objekte Arbeitsblätter ( Worksheets) durch Anwendung die .Punkt danach
wsIn.Range("A1").CurrentRegion.ClearContents
Dim Zelle As Range
Dim ZellValue2 As String 'Wann mogliech bemutz variablen für Zelle Werte um zu mimieren wenn AbeitsBlätter ist referenziert, ( bein suche nach Unterstriche muss es, abe für werte nicht
Dim lr As Long: Let lr = wsOutIn.Cells(Rows.Count, 2).End(xlUp).Row 'So in Spalte 2 der letzte Bereich (Zelle) hat die End-Eigenschaft (mit Parameter (Argument) Up) angewandt, um einen anderen Bereich (Zelle) zurückzugeben, bzw. die letzte Zelle mit eine  Eintrag in ist. Anwendung Die Row Eigenschaft auf diesen Bereich (Zelle) gibt die  Zeile Nummer dieses Zelle

Rem Verwenden Sie Microsoft Scripting Rintime Dictionary ( Wörterbuch ) um eindeutige Schlüssel referance Worte zu kreigen
'Wir "quasi" stellen also eindeutige Werte  in einem Wörterbuch für spätere Nachschlagzwecke:
'-erfordert Bibliothek Verweis auf MS Scripting Runtime ( Early Binding ) -
'Extras >> Verweis >> scrolle nach unten und selektieren  das Kontrollkästchen neben Microsoft Scripting Runtime
' ..oder Stürzt am nächsten Zeile
'    Dim dicOb As Scripting.Dictionary ' Daten hier hat einem eindeutigen "Schlüssel" oder Teilenummer
'    Set dicOb = New Scripting.Dictionary
'Die nächsten beiden Zeilen sind eine Alternative genannt Late Bindung . (Beachten Sie aber einige Dictionary Methoden und Eigenschaften werden nicht mit ihm arbeiten - in den Fällen, Early muss verwendet werden. )
Dim dicOb As Object
Set dicOb = CreateObject("Scripting.Dictionary") 'Späte Bindung ist besser, wenn man Austausch von Dateien will , so wie ich hier. Early Binding hat den Vorteil, dass Excel Intellisense
' Wird dann für die Microsoft Scripting Runtime Sachen zeigen, nachdem man die .DOT gibt

Rem 3 Selection basieret an ausgewählt berisch in wsIn
Dim rngSel As Range: 'Set rngSel = wsOutIn.Range("A2:D10") 'Test Bereich ('Bereich soll ausgewählt ab Spalten B
With wsOutIn 'Ab hier alles wie .fgfg bedeutet wsIn.fgfg------------------------------------------------
Set rngSel = .Range(.Cells(Selection.Row, Selection.Column), .Cells(Selection.Row + Selection.Rows.Count - 1, Selection.Column + Selection.Columns.Count - 1)) 'Selection Bereich gefunden von eigenschaften Selection Objekt. Diese Objekt hat Info übers Selected Teil von Arbeitsblätter drin

Rem Output Arrays
Dim arrOutIn() As Variant: Let arrOutIn() = rngSel.Value2 'Wenn die Eigenschaft .Value 2 auf einen Bereich von mehr als 1 Zelle angelegt ist,  kehrt ein Kollektion (Array) der meist basis Werte alle Zellen in diesem Bereich zuruck . VBA ermöglicht einen "One -Liner", um dann tu anweisen diese Wert auf einen dynamischen Array . Die Elemente dieser Kollektion werden zunächst als Variante durch VBA definiert. Deswegen mussten wir Dim Elementen als Variant
                    'Dim arrInOut() As String: ReDim arrInOut(1 To rngSel.Rows.Count, 1 To 2) 'Wir wissen schon große diesem Array und was wir einfühlen wollen,, und es wird gefühlt eine Element nach die andere. Deswegen  wir können und dürfen die Passender Dim Typ anweisen schon (Wim musste aber so zu erste machen und dann REDim statt an einfach Dim weil Dim lässt sich nur nummern anweisen, ReDim aber lässt anweisen von variablen
Dim arrIndex() As String 'Wir wissen noch nicht große diesem Array aber wissen was wir einfühlen wollen, und es wird gefühlt eine Element nach die andere. Deswegen  wir können und dürfen die Passender Dim Typ anweisen schon (Wir musste aber so zu erste machen und dann danach REDim statt an einfach Dim weil Dim lässt sich nur nummern anweisen, ReDim aber lässt anweisen von variablen

Rem 4 Haupt Schleife. Baut non Duplikat refferences sowie modificieret Input ( OutIn ) Array um zu zeig wenn Unterstrichen
Dim z As Variant, Keys() As Variant 'mit bau von non Duplikat refferences verwenden. Keys wird von anweisen zu eine collection die als Varianten definieret sind. Deswegen, wie beim .Rang.Value mussen wir Typ als Varianten haben
Dim j As Long, i As Long, rOffset As Long: Let rOffset = rngSel.Row - 1
    For j = 2 To rngSel.Columns.Count 'Für selektieret Bereich außer erste splaten...
        For i = 1 To rngSel.Rows.Count '... schau alle "rows"
        'Dieses Mehtode unter =.Item() einfach Art , die uns eindeutige Schlüssel ohne Vergabe Einträge machen zu mussen   http://www.snb-vba.eu/VBA_Dictionary_en.html       '   -- Normallerweise .Item() verwendet man, um ein Element von eine eindeutiger Schlüssel, .Item, zu einem vaiable zuweisen, bzw.  z = dicLookupTable.Item(x(i))   Wenn der Schlüssel aber nicht existiert, dann wird es gemacht - Cool oder ? --- ( Und kein Wert wird in die Variable angegeben werden ( aber das braucht auch Variable typ Variant) )
        If arrOutIn(i, j) <> "" And Right(arrOutIn(i, j), 1) <> "U" Then Let z = dicOb.Item(arrOutIn(i, j))  'man wäre nichts sehen hier in z: Post #7 # 12 #14  http://www.excelforum.com/excel-programming-vba-macros/1083899-copy-and-paste-entire-row-to-second-sheet-based-on-cell-value.html
    '        vTemp = .Cells(i, j).Font.Underline'Für Debugging Evtl.
            If .Cells(i + rOffset, j).Value2 <> "" And .Cells(i + rOffset, j).Font.Underline = 2 Then 'Value 2 ist meist Basiswert und geht schneller, deswegen benutz dieses wenn mogleish
            arrOutIn(i, j) = arrOutIn(i, j) & "U" 'Modifizieren falls nummer ist unterstrichen
            Else
            End If
       Next i
    Next j
Let Keys() = dicOb.Keys 'Die non Duplikat schlüssel Worte ( Teil Nummer ) ( Unserrere refferences ) can dan von dicOb Eigentschaft bekommen
End With ' wsOutIn

Rem 5 Scleifen um Output Array ( Index ) zu bauern
Dim dI As String, d As Long, stringtemp As String
ReDim arrIndex(1 To dicOb.Count, 1 To 2) 'Wir wissen jetzt nummer von Non Duplicat Referrences Keys(d - 1)
    For d = 1 To dicOb.Count 'Für jede Non Duplicat Referrences..
        For j = 2 To rngSel.Columns.Count 'Bau string von alle Element in Input Array für dieses refferrence,
            For i = 1 To rngSel.Rows.Count
                If arrOutIn(i, j) = Keys(d - 1) Then stringtemp = stringtemp & arrOutIn(i, 1) & "  "
                If arrOutIn(i, j) = Keys(d - 1) & "U" Then stringtemp = stringtemp & arrOutIn(i, 1) & "U  "
            Next i
        Next j
        arrIndex(d, 1) = Keys(d - 1): arrIndex(d, 2) = stringtemp 'Wir habe jetzt die string von verketteten Seite Nummern
        stringtemp = "" 'Wir wollen diese variablen fürs nächste verketteten Seite Nummern, also soll es jetzt entleeren das wir für diesen Ouput 2row fertig damit sind
    Next d
    
Let wsIn.Range("a1").Resize(UBound(arrIndex(), 1), UBound(arrIndex(), 2)).Value = arrIndex() ''Einfach weg zu fügen Sie Output Array in einem Linie: Ändern Sie die Größe des Bereichs (Zelle) links oben in dem Ausgangsdaten sollte, zu der Größe der Ausgabe-Array, dann verwenden Sie die zulässige VBA "One -Liner " , um die Werte aus einem Array in eine Tabelle Bereich zuordnen zo können
    
End Sub

[DocAElstein]

Welcome to The Board Kyle,
. May your extension come out as colorful here as in Other Forums
. Thankyou for Getting it out here for us to play with
Alan

P.s. That's a Geil code you have there

P.s. Wierd to see you decribed as a Member

[Kyle]

No problem, was a trivial change , you can update your extension now to get it to work or you can just wait for it to auto update

[Kyle]

Testing from chrome store:

        Sub test()
        
            Dim cn As ADODB.Connection
            Dim rs As ADODB.Recordset
            Dim sql As String
            
            Rem A full line comment
            Set cn = New ADODB.Connection 'end of line comment
            cn.ConnectionString = _
                "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=C:\MYFILEPATH;Extended Properties='text;HDR=Yes';"
            cn.Open
        
            sql = "Select * FROM " & "[MYFILE.CSV]"
            
            'Something else
            Set rs = cn.Execute(sql)
        
        End Sub

[DocAElstein]

….in … IE11 browser….. (right mouse click insert ( Copied from WORD ))

X x x x x x x x x x x xx x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x x

Font size ( Verdana )

8
9
10
11
12
14
16