-
Notes for this Post
https://excelfox.com/forum/showthrea...COPY-AND-PASTE
In 1.xls count the total number of rows that has data and copy the 3.xlsx sheet3 first row(first complete row copy) and paste that much time of 3.xlsx first row of sheet3 to 2.csv ........_
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
M |
|---|
1 |
Exchange |
Symbol |
Series/Expiry |
Open |
High |
Low |
Prev Close |
LTP |
|
|
|
|
|
2 |
NSE |
ACC |
EQ |
1182 |
1193 |
1151.7 |
1190.45 |
1156.6 |
22 |
11.566 |
116815 |
1168.166 |
|
3 |
NSE |
ADANIENT |
EQ |
137.15 |
140.55 |
134.1 |
140.5 |
134.65 |
25 |
1.3465 |
13595 |
135.9965 |
|
4 |
NSE |
ADANIPORTS |
EQ |
273.95 |
276.95 |
269.55 |
277.6 |
270.65 |
15083 |
2.7065 |
27335 |
273.3565 |
|
5 |
NSE |
ADANIPOWER |
EQ |
32.3 |
32.35 |
30.45 |
32.45 |
30.65 |
17388 |
0.3065 |
3095 |
30.9565 |
|
6 |
NSE |
AMARRAJA |
EQ |
555 |
555 |
529.25 |
557.85 |
532.1 |
100 |
5.321 |
5374 |
537.21 |
|
7 |
|
|
|
|
|
|
|
|
|
|
|
|
|
_____ Workbook: 3.xlsx ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
|---|
1 |
NSE |
|
6 |
|
|
A |
|
|
|
|
GTT |
|
2 |
|
|
|
|
|
|
|
|
|
|
|
|
3 |
|
|
|
|
|
|
|
|
|
|
|
|
_..........
suppose 1.xls has data in 5 rows then copy 3.xlsx first row of sheet3 and paste it to 2.csv 5 times
_____ Workbook: 2.csv ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
I |
J |
K |
L |
|---|
1 |
NSE |
|
6 |
|
|
A |
|
|
|
|
GTT |
|
2 |
NSE |
|
6 |
|
|
A |
|
|
|
|
GTT |
|
3 |
NSE |
|
6 |
|
|
A |
|
|
|
|
GTT |
|
4 |
NSE |
|
6 |
|
|
A |
|
|
|
|
GTT |
|
5 |
NSE |
|
6 |
|
|
A |
|
|
|
|
GTT |
|
6 |
|
|
|
|
|
|
|
|
|
|
|
|
-
macro solution for last post and solution for
https://excelfox.com/forum/showthrea...ll=1#post13185
In the macro I have done for you , there are two possibilities.
You only need one
You can choose
' 2b)(i) Relative formula references ...
Code:
' 2b)(i) Relative formula references ... https://teylyn.com/2017/03/21/dollarsigns/#comment-191
Ws2.Cells.NumberFormat = "General" ' May be needed to prevent formulas coming out as test =[3.xlsx]Sheet1!$A$1
Let rngOut.Value = "='[3.xlsx]" & Ws3.Name & "'!A$1"
Let rngOut.Value = rngOut.Value ' Change Formulas to values
Let rngOut.Value = Evaluate("If({1},SUBSTITUTE(" & rngOut.Address & ", ""0"", """"))") ' https://excelribbon.tips.net/T010741_Removing_Spaces
' Or
'' 2b)(ii) Copy paste
'Dim rngIn As Range
' Set rngIn = Ws3.Range("A1:" & Lc3Ltr & "1")
' rngIn.Copy
' rngOut.PasteSpecial Paste:=xlPasteValues ' understanding Paste across ranges of different size to Copy range : https://excelfox.com/forum/showthread.php/2221-VBA-Range-Insert-Method-Code-line-makes-a-space-to-put-new-range-in?p=10441&viewfull=1#post10441
OR
' 2b)(ii) Copy Paste
Code:
' 2b)(i) Relative formula referrences ... https://teylyn.com/2017/03/21/dollarsigns/#comment-191
' Ws2.Cells.NumberFormat = "General" ' May be needed to prevent formulas coming out as test =[3.xlsx]Sheet1!$A$1
' Let rngOut.Value = "='[3.xlsx]" & Ws3.Name & "'!A$1"
' Let rngOut.Value = rngOut.Value ' Change Formulas to values
' Let rngOut.Value = Evaluate("If({1},SUBSTITUTE(" & rngOut.Address & ", ""0"", """"))") ' https://excelribbon.tips.net/T010741_Removing_Spaces
' Or
' 2b)(ii) Copy Paste
Dim rngIn As Range
Set rngIn = Ws3.Range("A1:" & Lc3Ltr & "1")
rngIn.Copy
rngOut.PasteSpecial Paste:=xlPasteValues ' understanding Paste across ranges of different size to Copy range : https://excelfox.com/forum/showthread.php/2221-VBA-Range-Insert-Method-Code-line-makes-a-space-to-put-new-range-in?p=10441&viewfull=1#post10441
Code:
Sub Step14() ' http://www.eileenslounge.com/viewtopic.php?f=30&t=34508 (zyxw123) https://excelfox.com/forum/showthread.php/2467-COPY-AND-PASTE?p=13182#post13182
Rem 1 Worksheets info
Dim w1 As Workbook, w2 As Workbook, w3 As Workbook
Set w1 = Workbooks("1.xls") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xlsx")
Set w2 = Workbooks("2.csv") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\document\2.csv")
Set w3 = Workbooks("3.xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\files\3.xlsx")
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
Set Ws1 = w1.Worksheets.Item(1)
Set Ws2 = w2.Worksheets.Item(1)
Set Ws3 = w3.Worksheets.Item(1)
Dim Lc3 As Long, Lenf1 As Long, Lr1 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
Let Lc3 = Ws3.Cells.Item(1, Ws3.Columns.Count).End(xlToLeft).Column
Dim Lc3Ltr As String
Let Lc3Ltr = CL(Lc3)
Rem 2 ' In 1.xls count the total number of rows that has data and copy the 3.xlsx sheet3 first row(first complete row copy) and paste that much time of 3.xlsx first row of sheet3 to 2.csv
Let Lenf1 = Lr1 - 1 ' 1.xls first row has headers so dont count that
' 2a)
Dim rngOut As Range: Set rngOut = Ws2.Range("A1:" & Lc3Ltr & Lenf1 & "")
' 2b)(i) Relative formula referrences ... https://teylyn.com/2017/03/21/dollarsigns/#comment-191
Ws2.Cells.NumberFormat = "General" ' May be needed to prevent formulas coming out as test =[3.xlsx]Sheet1!$A$1
Let rngOut.Value = "='[3.xlsx]" & Ws3.Name & "'!A$1"
Let rngOut.Value = rngOut.Value ' Change Formulas to values
Let rngOut.Value = Evaluate("If({1},SUBSTITUTE(" & rngOut.Address & ", ""0"", """"))") ' https://excelribbon.tips.net/T010741_Removing_Spaces
' Or
' 2b)(ii) Copy Paste
Dim rngIn As Range
Set rngIn = Ws3.Range("A1:" & Lc3Ltr & "1")
rngIn.Copy
rngOut.PasteSpecial Paste:=xlPasteValues ' understanding Paste across ranges of different size to Copy range : https://excelfox.com/forum/showthread.php/2221-VBA-Range-Insert-Method-Code-line-makes-a-space-to-put-new-range-in?p=10441&viewfull=1#post10441
Rem 3
' w1.Close
' w2.Save
' Let Application.DisplayAlerts = False
' w2.Close
' Let Application.DisplayAlerts = True
' w3.Close
'
End Sub
Code:
' http://www.excelfox.com/forum/showthread.php/1546-TESTING-Column-Letter-test-Sort
Public Function CL(ByVal lclm As Long) As String ' http://www.excelforum.com/development-testing-forum/1101544-thread-post-appendix-no-reply-needed-please-do-not-delete-thanks-4.html#post4213980
Do: Let CL = Chr(65 + (((lclm - 1) Mod 26))) & CL: Let lclm = (lclm - (1)) \ 26: Loop While lclm > 0
End Function
-
2 Attachment(s)
In support to answer to this Thread
https://excelfox.com/forum/showthrea...COPY-AND-PASTE
from about here:
https://excelfox.com/forum/showthrea...ll=1#post13193
Before csv file link https://drive.google.com/open?id=1MF...s6EWCLjkblGxfo
Before csv.jpg : https://imgur.com/NLryZml
Attachment 2900
After runing macro csv link https://drive.google.com/open?id=1V_...S63idSd5zlDcVX
After csv.JPG : : https://imgur.com/IzaxRrh
Attachment 2901
Analysing what we have before and after
To get the single string of what is in the file, from here , https://www.homeandlearn.org/open_a_...le_in_vba.html https://www.homeandlearn.org/write_to_a_text_file.html ,
I use the below macro to analyse the supplied from vixer google drive share file for Before, ( Sub WtchaGot_Unic_NotMuchIfYaChoppedItOff(ByVal strIn As String) is in next post )
Code:
' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13208&viewfull=1#post13208
Sub TestieCSVstringBefore()
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = ThisWorkbook.Path & "\" & "2 Before.csv" ' From vixer : https://excelfox.com/forum/showthread.php/2467-COPY-AND-PASTE?p=13193&viewfull=1#post13193 Before csv file link https://drive.google.com/file/d/1MFIgUUiH0QPO1oWpDms6EWCLjkblGxfo/view Before csv.jpg : https://imgur.com/NLryZml
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' What the fuck is in this string?
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile)
End Sub
After running the above macro I get this analysis:
_._________________________________________
I repeat the same for the supplied After file.
Code:
' Sub WtchaGot_Unic_NotMuchIfYaChoppedItOff(ByVal strIn As String) ' ' https://excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string ' https://excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=11015&viewfull=1#post11015
Sub TestieCSVstringAfter()
Dim FileNum As Long: Let FileNum = FreeFile(1) ' https://msdn.microsoft.com/en-us/vba/language-reference-vba/articles/freefile-function
Dim PathAndFileName As String, TotalFile As String
Let PathAndFileName = ThisWorkbook.Path & "\" & "2.csv" ' From vixer : https://excelfox.com/forum/showthread.php/2467-COPY-AND-PASTE?p=13193&viewfull=1#post13193 After runing macro csv link https://drive.google.com/file/d/1V_85p1O4lV4RvqHw1dS63idSd5zlDcVX/view After csv.JPG : : https://imgur.com/IzaxRrh
Open PathAndFileName For Binary As #FileNum 'Open Route to data. Binary is a fundemental type data input...
TotalFile = Space(LOF(FileNum)) '....and wot recives it hs to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' What the fuck is in this string?
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(TotalFile)
End Sub
Here is the result
Code:
"NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf & "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf & "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf & "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf & "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf
vbCr & vbLf
It is a single long string
Here the same again , differently shown, just for clarity. But remember, it is actually a single long string.
Code:
"NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf &
"NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf &
"NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf &
"NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf &
"NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf
Or like
"NSE" vbTab vbTab "6" vbTab vbTab vbTab "A" vbTab vbTab vbTab vbTab vbTab "GTT" vbCr vbLf
"NSE" vbTab vbTab "6" vbTab vbTab vbTab "A" vbTab vbTab vbTab vbTab vbTab "GTT" vbCr vbLf
"NSE" vbTab vbTab "6" vbTab vbTab vbTab "A" vbTab vbTab vbTab vbTab vbTab "GTT" vbCr vbLf
"NSE" vbTab vbTab "6" vbTab vbTab vbTab "A" vbTab vbTab vbTab vbTab vbTab "GTT" vbCr vbLf
"NSE" vbTab vbTab "6" vbTab vbTab vbTab "A" vbTab vbTab vbTab vbTab vbTab "GTT" vbCr vbLf
-
Function required for last post
Code:
' https://excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string
' https://excelfox.com/forum/showthread.php/2302-quot-What%E2%80%99s-in-a-String-quot-VBA-break-down-Loop-through-character-contents-of-a-string?p=11015&viewfull=1#post11015
Sub WtchaGot_Unic_NotMuchIfYaChoppedItOff(ByVal strIn As String) '
Rem 1 ' Output "sheet hardcopies"
'1a) Worksheets 'Make Temporary Sheets, if not already there, in Current Active Workbook, for a simple list of all characters, and for pasting the string into worksheet cells
'1a)(i) Full list of characters worksheet
If Not Evaluate("=ISREF(" & "'" & "WotchaGotInString" & "'!Z78)") Then ' ( the ' are not important here, but iin general allow for a space in the worksheet name like "Wotcha Got In String"
Dim Wb As Workbook ' ' ' Dim: ' Preparing a "Pointer" to an Initial "Blue Print" in Memory of the Object ( Pigeon Hole with a bit of paper or code lines on that can be filled in to refer to a specific Objec of this type ) . This also us to get easily at the Methods and Properties throught the applying of a period ( .Dot) ( intellisense ) '
Set Wb = ActiveWorkbook ' ' Set now (to Active Workbook - one being "looked at"), so that we carefull allways referrence this so as not to go astray through Excel Guessing inplicitly not the one we want... Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed. http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191 '
Wb.Worksheets.Add After:=Wb.Worksheets.Item(Worksheets.Count) 'A sheeet is added and will be Active
Dim ws As Worksheet '
Set ws = ActiveSheet 'Rather than rely on always going to the active sheet, we referr to it Explicitly so that we carefull allways referrence this so as not to go astray through Excel Guessing implicitly not the one we want... Set: Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed. http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191 ' Values are filled at the memory locations and the directions there are specified in the variable "Blue Print "Pointer". In this case a Filled in Blue Print is passed. http://www.excelforum.com/excel-programming-vba-macros/1138804-help-understanding-class-instancing-cant-set-ws-new-worksheet-intellisense-offers-it-4.html#post4387191
ws.Activate: ws.Cells(1, 1).Activate ' ws.Activate and activating a cell sometimes seemed to overcome a strange error
Let ws.Name = "WotchaGotInString"
Else ' The worksheet is already there , so I just need to set my variable to point to it
Set ws = ThisWorkbook.Worksheets("WotchaGotInString")
End If
'1a(ii) Worksheet to paste out string into worksheet cells
If Not Evaluate("=ISREF(" & "'" & "StrIn|WtchaGot" & "'!Z78)") Then
Set Wb = ActiveWorkbook
Wb.Worksheets.Add Before:=Wb.Worksheets.Item(1)
Dim Ws1 As Worksheet
Set Ws1 = ActiveSheet
Ws1.Activate: Ws1.Cells(1, 1).Activate
Let Ws1.Name = "StrIn|WtchaGot"
Else
Set Ws1 = ThisWorkbook.Worksheets("StrIn|WtchaGot")
End If
'1b) Array
Dim myLenf As Long: Let myLenf = Len(strIn) ' ' Long is very simple to handle, - final memory "size" type is known (123.456 and 000.001 have same "size" computer memory ) , and so a Address suggestion can be given for the next line when the variable is filled in. '( 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. ) https://www.mrexcel.com/forum/excel-questions/803662-byte-backward-loop-4.html
Dim arrWotchaGot() As String: ReDim arrWotchaGot(1 To myLenf + 1, 1 To 2) ' +1 for header Array for the output 2 column list. The type is known and the size, but I must use this ReDim method simply because the dim statement Dim( , ) is complie time thing and will only take actual numbers
Let arrWotchaGot(1, 1) = Format(Now, "DD MMM YYYY") & vbLf & "Lenf is " & myLenf: Let arrWotchaGot(1, 2) = Left(strIn, 40)
Rem 2 String anylaysis
'Dim myLenf As Long: Let myLenf = Len(strIn)
Dim Cnt As Long
For Cnt = 1 To myLenf ' ===Main Loop========================================================================
' Character analysis: Get at each character
Dim Caracter As Variant ' String is probably OK.
Let Caracter = Mid(strIn, Cnt, 1) ' ' the character in strIn at position from the left of length 1
'2a) The character added to a single WotchaGot long character string to look at and possibly use in coding
Dim WotchaGot As String ' This will be used to make a string that I can easilly see and also is in a form that I can copy and paste in a code line required to build the full string of the complete character string
'2a)(i) Most common characters and numbers to be displayed as "seen normally" ' -------2a)(i)--
If Caracter Like "[A-Z]" Or Caracter Like "[0-9]" Or Caracter Like "[a-z]" Then ' Check for normal characters
'SirNirios
If Not Cnt = 1 Then ' I am only intersted in next line comparing the character before, and if i did not do this the next line would error if first character was a "normal" character
If Not Cnt = myLenf And (Mid(strIn, Cnt - 1, 1) Like "[A-Z]" Or Mid(strIn, Cnt - 1, 1) Like "[0-9]" Or Mid(strIn, Cnt - 1, 1) Like "[a-z]") Then ' And (Mid(strIn, Cnt + 1, 1) Like "[A-Z]" Or Mid(strIn, Cnt + 1, 1) Like "[0-9]" Or Mid(strIn, Cnt + 1, 1) Like "[a-z]") Then
Let WotchaGot = WotchaGot & "|LinkTwoNormals|"
Else
End If
Else
End If
Let WotchaGot = WotchaGot & """" & Caracter & """" & " & " ' This will give the sort of output that I need to write in a code line, so for example if I have a123 , this code line will be used 4 times and give like a final string for me to copy of "a" & "1" & "2" & "3" & I would phsically need to write in code like strVar = "a" & "1" & "2" & "3" - i could of course also write = "a123" but the point of this routine is to help me pick out each individual element
Else ' Some other things that I would like to "see" normally - not "normal simple character" - or by a VBA constant, like vbCr vbLf vbTab
Select Case Caracter ' 2a)(ii)_1
Case " "
Let WotchaGot = WotchaGot & """" & " " & """" & " & "
Case "!"
Let WotchaGot = WotchaGot & """" & "!" & """" & " & "
Case "$"
Let WotchaGot = WotchaGot & """" & "$" & """" & " & "
Case "%"
Let WotchaGot = WotchaGot & """" & "%" & """" & " & "
Case "~"
Let WotchaGot = WotchaGot & """" & "~" & """" & " & "
Case "&"
Let WotchaGot = WotchaGot & """" & "&" & """" & " & "
Case "("
Let WotchaGot = WotchaGot & """" & "(" & """" & " & "
Case ")"
Let WotchaGot = WotchaGot & """" & ")" & """" & " & "
Case "/"
Let WotchaGot = WotchaGot & """" & "/" & """" & " & "
Case "\"
Let WotchaGot = WotchaGot & """" & "\" & """" & " & "
Case "="
Let WotchaGot = WotchaGot & """" & "=" & """" & " & "
Case "?"
Let WotchaGot = WotchaGot & """" & "?" & """" & " & "
Case "'"
Let WotchaGot = WotchaGot & """" & "'" & """" & " & "
Case "+"
Let WotchaGot = WotchaGot & """" & "+" & """" & " & "
Case "-"
Let WotchaGot = WotchaGot & """" & "-" & """" & " & "
Case "_"
Let WotchaGot = WotchaGot & """" & "_" & """" & " & "
Case "."
Let WotchaGot = WotchaGot & """" & "." & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' ' 2a)(ii)_2
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
' Case " "
' Let WotchaGot = WotchaGot & """" & " " & """" & " & "
Case vbCr
Let WotchaGot = WotchaGot & "vbCr & " ' I actuall would write manually in this case like vbCr &
Case vbLf
Let WotchaGot = WotchaGot & "vbLf & "
Case vbCrLf
Let WotchaGot = WotchaGot & "vbCrLf & "
Case vbNewLine
Let WotchaGot = WotchaGot & "vbNewLine & "
Case """" ' This is how to get a single " No one is quite sure how this works. My theory that, is as good as any other, is that syntaxly """" or " """ or """ " are accepted. But in that the """ bit is somewhat strange for VBA. It seems to match the first and Third " together as a valid pair but the other " in the middle of the 3 "s is also syntax OK, and does not error as """ would because of the final 4th " which it syntaxly sees as a valid pair matched simultaneously as it does some similar check on the first and Third as a concluding string pair. All is well except that the second " is captured within a accepted enclosing pair made up of the first and third " At the same time the 4th " is accepted as a final concluding " paired with the second which it is using but at the same time now isolated from.
Let WotchaGot = WotchaGot & """" & """" & """" & """" & " & " ' The reason why "" "" would not work is that at the end of the "" the next empty character signalises the end of a string pair, and only if it saw a " would it keep checking the syntax rules which then lead in the previous case to the situation described above.
Case vbTab
Let WotchaGot = WotchaGot & "vbTab & "
' 2a)(iii)
Case Else
If AscW(Caracter) < 256 Then
Let WotchaGot = WotchaGot & "Chr(" & AscW(Caracter) & ")" & " & "
Else
Let WotchaGot = WotchaGot & "ChrW(" & AscW(Caracter) & ")" & " & "
End If
'Let CaseElse = Caracter
End Select
End If ' End of the "normal simple character" or not ' -------2a)------Ended-----------
'2b) A 2 column Array for convenience of a list
Let arrWotchaGot(Cnt + 1, 1) = Cnt & " " & Caracter: Let arrWotchaGot(Cnt + 1, 2) = AscW(Caracter) ' +1 for header
Next Cnt ' ========Main Loop=================================================================================
'2c) Some tidying up
If WotchaGot <> "" Then
Let WotchaGot = Left(WotchaGot, Len(WotchaGot) - 3) ' take off last " & " ( 2 spaces one either side of a & )
Let WotchaGot = Replace(WotchaGot, """ & |LinkTwoNormals|""", "", 1, -1, vbBinaryCompare)
' The next bit changes like this "Lapto" & "p" to "Laptop" You might want to leave it out ti speed things up a bit
If Len(WotchaGot) > 5 And (Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[A-Z]" Or Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[0-9]" Or Mid(WotchaGot, Len(WotchaGot) - 1, 1) Like "[a-z]") And (Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[A-Z]" Or Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[0-9]" Or Mid(WotchaGot, Len(WotchaGot) - 7, 1) Like "[a-z]") And Mid(WotchaGot, Len(WotchaGot) - 6, 5) = """" & " & " & """" Then
Let WotchaGot = Left$(WotchaGot, Len(WotchaGot) - 7) & Mid(WotchaGot, Len(WotchaGot) - 1, 2) ' Changes like this "Lapto" & "p" to "Laptop"
Else
End If
Else
End If
Rem 3 Output
'3a) String
'3a)(i)
MsgBox Prompt:=WotchaGot: Debug.Print WotchaGot ' Hit Ctrl+g from the VB Editor to get a copyable version of the entire string
'3a)(ii)
Ws1.Activate: Ws1.Cells.Item(1, 1).Activate
Let Ws1.Range("A1").Value = strIn
Let Ws1.Range("B1").Value = WotchaGot
'3b) List
Dim NxtClm As Long: Let NxtClm = 1 ' In conjunction with next If this prevents the first column beine taken as 0 for an empty worksheet
ws.Activate: ws.Cells.Item(1, 1).Activate
If Not ws.Range("A1").Value = "" Then Let NxtClm = ws.Cells.Item(1, Columns.Count).End(xlToLeft).Column + 1
Let ws.Cells.Item(1, NxtClm).Resize(UBound(arrWotchaGot(), 1), UBound(arrWotchaGot(), 2)).Value = arrWotchaGot()
ws.Cells.Columns.AutoFit
End Sub
'
-
Next solution attempt for this:
https://excelfox.com/forum/showthrea...ll=1#post13219
Do not put a code line in the macro to open 2.csv!
Code:
Sub Step14_DogShit() ' https://excelfox.com/forum/showthread.php/2467-COPY-AND-PASTE?p=13219&viewfull=1#post13219
Rem 1 Worksheets info
Dim w1 As Workbook, w2 As Workbook, w3 As Workbook
Set w1 = Workbooks("1.xls") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xlsx")
' Do Not open 2.csv ' Set w2 = Workbooks("2.csv") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\document\2.csv")
Set w3 = Workbooks("3.xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\files\3.xlsx")
Dim Ws1 As Worksheet, Ws2 As Worksheet, Ws3 As Worksheet
Set Ws1 = w1.Worksheets.Item(1)
' Set Ws2 = w2.Worksheets.Item(1)
Set Ws3 = w3.Worksheets.Item(1)
Dim Lc3 As Long, Lenf1 As Long, Lr1 As Long
Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row ' http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=11466&viewfull=1#post11466 Making Lr dynamic ( using rng.End(XlUp) for a single column. )
' Let Lc3 = Ws3.Cells.Item(1, Ws3.Columns.Count).End(xlToLeft).Column
' Dim Lc3Ltr As String
' Let Lc3Ltr = CL(Lc3)
Rem 2 ' In 1.xls count the total number of rows that has data and copy the 3.xlsx sheet3 first row(first complete row copy) and paste that much time of 3.xlsx first row of sheet3 to 2.csv
Let Lenf1 = Lr1 - 1 ' 1.xls first row has headers so dont count that
' 2a) get range to be put into dog shit files
Dim arrIn() As Variant: Let arrIn() = Ws3.Range("A1:K1").Value
' 2b) make a string fow a row, including a dog shit Tab seperator
Dim cnt
For cnt = 1 To UBound(arrIn(), 2) ' Column count in worksheet 3 row 1
Dim strLine As String
Let strLine = strLine & arrIn(1, cnt) & vbTab
Next cnt
Let strLine = Left(strLine, (Len(strLine) - 1)) ' Take off last Tab
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strLine) ' "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT"
' 2c) repeat string to include (and include line breaks) to make complete string for do shit text files
For cnt = 1 To Lenf1 ' row count of our dog shit text files
Dim strTotalFile As String
Let strTotalFile = strTotalFile & strLine & vbCr & vbLf
Next cnt
' Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strTotalFile) ' https://excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13218&viewfull=1#post13218
Rem 4 make dogshit files
' 4a) Dog Shit text
Dim Highway1 As Long: Let Highway1 = FreeFile(0) 'range 1 – 255, inclusive - next free
Open ThisWorkbook.Path & "\" & "DogShit.txt" For Append As #Highway1 ' Will be made if not there
Print #Highway1, strTotalFile
Close #Highway1
' 4b) 2.csv
Dim Highway2 As Long: Let Highway2 = FreeFile(0) 'range 1 – 255, inclusive - next free
Open ThisWorkbook.Path & "\" & "2.csv" For Append As #Highway2 ' Will be made if not there
Print #Highway2, strTotalFile
Close #Highway2
Rem ....
' w1.Close
' w2.Save
'' Let Application.DisplayAlerts = False
'' w2.Close
'' Let Application.DisplayAlerts = True
' w3.Close
'
End Sub
-
Some Development results from running macro from last post
Code:
"NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT"
"NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf & "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf & "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf & "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf & "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strLine)
"NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT"
Call WtchaGot_Unic_NotMuchIfYaChoppedItOff(strTotalFile )
"NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf
& "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf
& "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf
& "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT" & vbCr & vbLf
& "NSE" & vbTab & vbTab & "6" & vbTab & vbTab & vbTab & "A" & vbTab & vbTab & vbTab & vbTab & vbTab & "GTT"
& vbCr & vbLf
-
In support of these Post
https://excelfox.com/forum/showthrea...ll=1#post13246
http://www.eileenslounge.com/viewtop...268627#p268627
These are all text Files. The macro in the next post ( https://excelfox.com/forum/showthrea...ll=1#post13248 ) will make them
XXXXSeperatedValuesTextFiles.JPG : https://imgur.com/A2IebLK
Comma Seperated values
(Sometimes called English Comma Seperated Values )
| zyxw123 |
, |
jhas |
, |
|
, |
rider |
, |
roger |
, |
anjus |
, |
sumanjjj |
| Leonardo |
, |
umpsbug |
, |
kinjals |
, |
|
, |
tinamishra |
, |
kinjal124 |
, |
WigWam |
Share ‘CommaSeperatedValues.txt’ : https://app.box.com/s/qcjpeu0vt875513gqawmtoufeba3xb28
Share ‘CommaSeperatedValues.csv’ : https://app.box.com/s/w2barpwasveltam4lutjwijks0zft0vq
Tab Seperated Values
| zyxw123 |
|
jhas |
|
|
|
rider |
|
roger |
|
anjus |
|
sumanjjj |
| Leonardo |
|
umpsbug |
|
kinjals |
|
|
|
tinamishra |
|
kinjal124 |
|
WigWam |
Share ‘TabSeperatedValues.csv’ : https://app.box.com/s/ukgxcmxj8xhmy0gzvw5269zyjdmun28g
Share ‘TabSeperatedValues.txt’ : https://app.box.com/s/d24blwuejfixh9ofhrg387nbadxjvu15
NMOD Seperated Values
| zyxw123 |
NMOD |
jhas |
NMOD |
|
NMOD |
rider |
NMOD |
roger |
NMOD |
anjus |
NMOD |
sumanjjj |
| Leonardo |
NMOD |
umpsbug |
NMOD |
kinjals |
NMOD |
|
NMOD |
tinamishra |
NMOD |
kinjal124 |
NMOD |
WigWam |
Share ‘NMODSeperatedValues.csv’ : https://app.box.com/s/ohxqrao160vapx5jozhx7ejc4t70v1wl
Share ‘NMODSeperatedValues.txt’ : https://app.box.com/s/46p14u9rfwvve0s4yv01zyy34f6qhmmz
Semi Colon Seperated Values
(Sometimes called German Comma Seperated values)
| zyxw123 |
; |
jhas |
; |
|
; |
rider |
; |
roger |
; |
anjus |
; |
sumanjjj |
| Leonardo |
; |
umpsbug |
; |
kinjals |
; |
|
; |
tinamishra |
; |
kinjal124 |
; |
WigWam |
Share ‘SemiColonSeperatedValues.csv’ : https://app.box.com/s/kvqqfsjaebzj684rw8n0u1v4hqfi3hea
Share ‘SemiColonSeperatedValues.txt’ : https://app.box.com/s/qojzd9ogwgg2d2unh2k8dkvwzdpgh84e
GollyWobbles Seperated Values
| zyxw123 |
GollyWobbles |
jhas |
GollyWobbles |
|
GollyWobbles |
rider |
GollyWobbles |
roger |
GollyWobbles |
anjus |
GollyWobbles |
sumanjjj |
| Leonardo |
GollyWobbles |
umpsbug |
GollyWobbles |
kinjals |
GollyWobbles |
|
GollyWobbles |
tinamishra |
GollyWobbles |
kinjal124 |
GollyWobbles |
WigWam |
Share ‘GollyWobblesSeperatedValues.txt’ : https://app.box.com/s/d0pktg8fadbkl8nfwnodfyle5766lghx
Share ‘GollyWobblesSeperatedValues.csv’ : https://app.box.com/s/5xbiy0wrc05txaofr7qknpot7cb3qdo3
Excel File With Wrong Extension
_____ Workbook: ExcelFileWithWrongExtension.csv ( Using Excel 2007 32 bit )
| Row\Col |
A |
B |
C |
D |
E |
F |
G |
H |
|---|
1 |
zyxw123 |
jhas |
|
rider |
roger |
anjus |
sumanjjj |
|
2 |
Leonardo |
umpsbug |
kinjals |
|
tinamishra |
kinjal124 |
fxe632 |
|
3 |
|
|
|
|
|
|
|
|
Share ‘ExcelFileWithWrongExtension.csv’ : https://app.box.com/s/esxlg0ovoux4gk29zxgklwog6zz6b7s1
-
In support of these Post
http://www.eileenslounge.com/viewtopic.php?f=30&t=34629
These are all text Files. The macro in this post ( https://excelfox.com/forum/showthrea...ll=1#post13248 ) will make them
XXXXSeperatedValuesTextFiles.JPG : https://imgur.com/A2IebLK
PipeSeperatedValuesTextFiles.JPG : https://imgur.com/Y9676cg
Comma Seperated values
(Sometimes called English Comma Seperated Values )
| zyxw123 |
, |
jhas |
, |
|
, |
rider |
, |
roger |
, |
anjus |
, |
sumanjjj |
| Leonardo |
, |
umpsbug |
, |
kinjals |
, |
|
, |
tinamishra |
, |
kinjal124 |
, |
WigWam |
Share ‘CommaSeperatedValues.txt’ : https://app.box.com/s/qcjpeu0vt875513gqawmtoufeba3xb28
Share ‘CommaSeperatedValues.csv’ : https://app.box.com/s/w2barpwasveltam4lutjwijks0zft0vq
Pipe Seperated Text Files
| zyxw123 |
| |
jhas |
| |
|
| |
rider |
| |
roger |
| |
anjus |
| |
sumanjjj |
| Leonardo |
| |
umpsbug |
| |
kinjals |
| |
|
| |
tinamishra |
| |
kinjal124 |
| |
WigWam |
Share ‘PipeSeperatedValues.txt’ : https://app.box.com/s/47eo2pmeqlmnjj5h9hlxog8ts47nlgj7
Share ‘PipeSeperatedValues.csv’ : https://app.box.com/s/o7zculmorhyys3r9b6hwwuc3wry1mr6p
-
In support of this Post
https://excelfox.com/forum/showthrea...ll=1#post13246
Run the macro below, Sub XXXXXSeperatedValuesTextFiles() ,
It will make text files in the same folder as the folder in which the macro is run in.
( The macro is also in the shared File, XXXXXSeperatedValues.xlsm )
XXXXSeperatedValuesTextFiles.JPG : https://imgur.com/A2IebLK
The text files are shown in the last post https://excelfox.com/forum/showthrea...ll=1#post13247
Code:
Option Explicit
Sub XXXXXSeperatedValuesTextFiles() ' https://excelfox.com/forum/showthread.php/2467-COPY-AND-PASTE?p=13246#post13246
Call Make____SeperatedValuesTextFiles("CommaSeperatedValues", ",") ' make CSV files ( Comma Seperated Values Files )
Call Make____SeperatedValuesTextFiles("TabSeperatedValues", vbTab) ' make Tab Seperated Values Files
Call Make____SeperatedValuesTextFiles("NMODSeperatedValues", "NMOD") ' make NMOD Seperated Values Files
Call Make____SeperatedValuesTextFiles("SemiColonSeperatedValues", ";") ' make ; Seperated Values Files ( sometimes called german Comma seperated files )
Call Make____SeperatedValuesTextFiles("GollyWobblesSeperatedValues", "GollyWobbles") ' make GollyWobbles Seperated Values Files
Call Make____SeperatedValuesTextFiles("PipeSeperatedValues", "|") ' make Pipe Seperated Values Files
End Sub
Sub Make____SeperatedValuesTextFiles(ByVal Filname As String, Seprator As String)
' Make long string for text file
Dim strTotalFile As String
Let strTotalFile = MakeA____SeperatedValuesTextFile(Seprator)
' .txt Text File
Dim Highway1 As Long: Let Highway1 = FreeFile(0) 'range 1 – 255, inclusive - next free
Open ThisWorkbook.Path & "\" & Filname & ".txt" For Append As #Highway1 ' Will be made if not there
Print #Highway1, strTotalFile
Close #Highway1
' .csv Text File
Dim Highway2 As Long: Let Highway2 = FreeFile(0) 'range 1 – 255, inclusive - next free
Open ThisWorkbook.Path & "\" & Filname & ".csv" For Append As #Highway2 ' Will be made if not there
Print #Highway2, strTotalFile
Close #Highway2
End Sub
Function MakeA____SeperatedValuesTextFile(ByVal Seprator As String) As String
Rem 1 Rows
Dim AvinashNamesRow1() As Variant, AvinashNamesRow2() As Variant
Let AvinashNamesRow1() = Array("zyxw123", "jhas", "", "rider", "roger", "anjus", "sumanjjj")
Let AvinashNamesRow2() = Array("Leonardo", "umpsbug", "kinjals", "", "tinamishra", "kinjal124", "fxe632")
Rem 2 make single string for text files
Dim strOut As String
Let strOut = Join(AvinashNamesRow1(), Seprator) & vbCr & vbLf & Join(AvinashNamesRow2(), Seprator) & vbCr & vbLf
Let MakeA____SeperatedValuesTextFile = strOut
End Function
Ref
https://excelfox.com/forum/showthrea...-a-range/page3
XXXXXSeperatedValues.xlsm : https://app.box.com/s/jvlu048tkg0rjw7xi4c4r838abw1z7bi
-
Quote:
Originally Posted by
DocAElstein
ADHahdhdh
do ya have : Attention deficit hyperactivity disorder (ADHD) ??? ;)
