Appendix Thread. ( Codes for other Threads, ( Avinash ).)

Macro for this Post
https://excelfox.com/forum/showthrea...ll=1#post14658
https://excelfox.com/forum/showthrea...ll=1#post14658

Code:

---

Sub OnlyHaveRowsWhereColumnCisNotEmpty()  '
Rem 1 Workbooks, Worksheets info
                                                                                                                  '    Dim Paf As String: Let Paf = ThisWorkbook.path ' - The path where all workbooks are  CHANGE TO SUIT
Dim arrWbs() As Variant
 Let arrWbs() = Array(ThisWorkbook.path & "\Book1.xlsx", ThisWorkbook.path & "\Book2.xlsx") ' - CHANGE TO SUIT
 Let arrWbs() = Array("C:\Users\WolfieeeStyle\Book1.xlsx", "C:\Users\WolfieeeStyle\Desktop\Book2.xlsx", "C:\Users\Desktop\MyBook.xlsx")  '

Dim Wb As Workbook, Ws As Worksheet
Rem 2 Looping through all files
Dim Stear As Variant
    For Each Stear In arrWbs()
    ' 2a Worksheets data info
    Set Wb = Workbooks.Open(Stear)
                                                                                                                  '    Set Wb = Workbooks.Open(Paf & "\" & Stear)
    Set Ws = Wb.Worksheets.Item(1)
    Dim LrC As Long: Let LrC = Ws.Range("C" & Ws.Rows.Count & "").End(xlUp).Row      ' Dynamically getting the last row in worksheet referenced by  Ws
    Dim arrC() As Variant: Let arrC() = Ws.Range("C1:C" & LrC & "").Value2
    ' 2b row indicies of rows not to be deleted
    Dim Cnt As Long
        For Cnt = 1 To LrC
        Dim strRws As String
            If arrC(Cnt, 1) <> "" Then Let strRws = strRws & Cnt & " "
        Next Cnt
    Let strRws = Left(strRws, Len(strRws) - 1) ' take off last space
    ' 2c Get the indicies in a vertical array, since the  "magic code line"  needs a vertical array
    Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare)  ' This gives us a 1 dimensional "horizontal" array  ( starting at indicie 0 )
    Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1)          ' +1 is needed because the
        For Cnt = 1 To UBound(Rws) + 1
        Let RwsT(Cnt, 1) = Rws(Cnt - 1)
        Next Cnt
    ' 2d get the output array from "magic code line" :
    Dim Clms() As Variant
    Let Clms() = Evaluate("=Column(A:U)")                                    ' for columns  1 2 3 4 5 6 7 8 9 10 11 12 13 14 125 16 17 18 19 20 21
    Dim arrOut() As Variant
    Let arrOut() = Application.Index(Ws.Cells, RwsT(), Clms())                      '  Magic code line            http://www.eileenslounge.com/viewtopic.php?p=265384#p265384    http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384          See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172  , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp  for full explanation
    ' 2e replace worksheet data with modified data arrayOut
    Ws.Cells.ClearContents
    Let Ws.Range("A1").Resize(UBound(arrOut(), 1), 21).Value2 = arrOut()  ' We can paste in one go the contents of an arrasy to a worksheet range
    '2f
    Let strRws = "" ' this is important or else in the next file loop, strRws it will still have values from the last loop
    Next Stear
End Sub


---

Note: You must change this line

Code:

---

Let arrWbs() = Array(ThisWorkbook.path & "\Book1.xlsx", ThisWorkbook.path & "\Book2.xlsx") ' - CHANGE TO SUIT
 

---

To something like this

Code:

---

Let arrWbs() = Array("C:\Users\WolfieeeStyle\Book1.xlsx", "C:\Users\WolfieeeStyle\Desktop\Book2.xlsx", "C:\Users\Desktop\MyBook.xlsx")  '


---

Getting URL for later use of this post

Macro for this post
https://excelfox.com/forum/showthrea...ll=1#post14664


The two changes for the dynamic column is
_1 a new line
Dim Lc As Long: Let Lc = Ws.UsedRange.Columns.Count - Ws.UsedRange.Column + 1
_2 Modify the column indicia code line, Clms() = Evaluate("=Column(A:U)")
Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")
_3 You need to include the function CL( )

Modified macro and required function, CL( )

Code:

---

Sub OnlyHaveRowsWhereColumnCisNotEmptyDynamicColumns()  '  https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14663&viewfull=1#post14663    https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14657#post14657
Rem 1 Workbooks, Worksheets info
                                                                                                                  '    Dim Paf As String: Let Paf = ThisWorkbook.path ' - The path where all workbooks are  CHANGE TO SUIT
Dim arrWbs() As Variant
 Let arrWbs() = Array(ThisWorkbook.path & "\Book1.xlsx", ThisWorkbook.path & "\Book2.xlsx") ' - CHANGE TO SUIT
' Let arrWbs() = Array("C:\Users\WolfieeeStyle\Book1.xlsx", "C:\Users\WolfieeeStyle\Desktop\Book2.xlsx", "C:\Users\Desktop\MyBook.xlsx")  '

Dim Wb As Workbook, Ws As Worksheet
Rem 2 Looping through all files
Dim Stear As Variant
    For Each Stear In arrWbs()
    ' 2a Worksheets data info
    Set Wb = Workbooks.Open(Stear)
                                                                                                                  '    Set Wb = Workbooks.Open(Paf & "\" & Stear)
    Set Ws = Wb.Worksheets.Item(1)
    Dim LrC As Long: Let LrC = Ws.Range("C" & Ws.Rows.Count & "").End(xlUp).Row      ' Dynamically getting the last row in worksheet referenced by  Ws
    Dim Lc As Long: Let Lc = Ws.UsedRange.Columns.Count - Ws.UsedRange.Column + 1    ' Dynamically getting the last column for the used range in Ws
    Dim arrC() As Variant: Let arrC() = Ws.Range("C1:C" & LrC & "").Value2
    ' 2b row indicies of rows not to be deleted
    Dim Cnt As Long
        For Cnt = 1 To LrC
        Dim strRws As String
            If arrC(Cnt, 1) <> "" Then Let strRws = strRws & Cnt & " "
        Next Cnt
    Let strRws = Left(strRws, Len(strRws) - 1) ' take off last space
    ' 2c Get the indicies in a vertical array, since the  "magic code line"  needs a vertical array
    Dim Rws() As String: Let Rws() = Split(strRws, " ", -1, vbBinaryCompare)  ' This gives us a 1 dimensional "horizontal" array  ( starting at indicie 0 )
    Dim RwsT() As Variant: ReDim RwsT(1 To UBound(Rws) + 1, 1 To 1)          ' +1 is needed because the
        For Cnt = 1 To UBound(Rws) + 1
        Let RwsT(Cnt, 1) = Rws(Cnt - 1)
        Next Cnt
    ' 2d get the output array from "magic code line" :
    Dim Clms() As Variant
'    Let Clms() = Evaluate("=Column(A:U)")                                    ' for columns  1 2 3 4 5 6 7 8 9 10 11 12 13 14 125 16 17 18 19 20 21
    Let Clms() = Evaluate("=Column(A:" & CL(Lc) & ")")
    Dim arrOut() As Variant
    Let arrOut() = Application.Index(Ws.Cells, RwsT(), Clms())                      '  Magic code line            http://www.eileenslounge.com/viewtopic.php?p=265384#p265384    http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384          See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172  , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp  for full explanation
    ' 2e replace worksheet data with modified data arrayOut
    Ws.Cells.ClearContents
    Let Ws.Range("A1").Resize(UBound(arrOut(), 1), 21).Value2 = arrOut()  ' We can paste in one go the contents of an arrasy to a worksheet range
    '2f
    Let strRws = "" ' this is important or else in the next file loop, strRws it will still have values from the last loop
    Next Stear
End Sub
 
 ' https://excelfox.com/forum/showthread.php/1546-TESTING-Column-Letter-test-Sort-Last-Row?p=7214#post7214
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

---

---

macro1.xlsm : https://app.box.com/s/tl3rs9693jwuv9c2w36ok8fpaewuf0ta
macro2.xlsm : https://app.box.com/s/t35238lm19bj6y0p6m6p68uaknsdf37z

For later use

Macro for this post
https://excelfox.com/forum/showthrea...ll=1#post14675

Code:

---

Sub DecimalPlaceAdjustment()
Rem 1 Worksheets info
Dim Wb1 As Workbook, Wb2 As Workbook
 Set Wb1 = Workbooks("1.xls")  '          ' CHANGE TO SUIT
 Set Wb2 = Workbooks("sample2.xlsx")
Dim Ws1 As Worksheet
 Set Ws1 = Wb1.Worksheets.Item(1)
Dim Ws2 As Worksheet
 Set Ws2 = Wb2.Worksheets.Item(1)
Dim Lr1 As Long, Lr2 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 Lr2 = Ws2.Range("A" & Ws1.Rows.Count).End(xlUp).Row
Dim arr1I() As Variant, arr2B() As Variant, arr2E() As Variant, arr1H() As Variant ' , arr1G() As Variant
 Let arr2B() = Ws2.Range("B1:B" & Lr2 & "").Value2
' Let arr1G() = Ws1.Range("G1:G" & Lr2 & "").Value2
 Let arr1I() = Ws1.Range("I1:I" & Lr1 & "").Value2
 Let arr2E() = Ws2.Range("E1:E" & Lr2 & "").Value2
 Let arr1H() = Ws1.Range("H1:H" & Lr1 & "").Value2
Rem 2 ' Do it
Dim Cnt
    For Cnt = 2 To Lr1 ' going through data down column I , Ws1
    '2a check for match data from column I Ws1 in column B Ws2
    Dim MtchRes As Variant
    Let MtchRes = Application.Match(arr1I(Cnt, 1), arr2B(), 0)
        If Not IsError(MtchRes) Then ' If MtchRes did not error then it tells us where  along  the match was found
        Dim LHInt As Long: Let LHInt = Len(Int(arr1H(Cnt, 1))) ' character Length of the integer of the value in H
        Let arr2E(MtchRes, 1) = Replace(arr2E(MtchRes, 1), ".", "", 1, 1, vbBinaryCompare) ' remove any decimal place in the matched row in 2.xlsx in column E
        Let arr2E(MtchRes, 1) = Left(arr2E(MtchRes, 1), LHInt) & "." & Mid(arr2E(MtchRes, 1), LHInt + 1)
        Else
        ' No match was found , so do nothing
        End If
    Next Cnt
Rem 3 Change column E in sample2.xlsx
 Let Ws2.Range("E1:E" & Lr2 & "").Value2 = arr2E()
End Sub

---

Notes in support of this Thread
https://excelfox.com/forum/showthrea...between-sheets

We are using the code line like
Index(Cells, Rws(), Clms)

This requires the array of required row numbers from the original worksheet, held in Rws()

These show the Row numbers concerned

Original range. ( First Worksheet Before )
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Rows in Original	Original	A	B	C	D	E	F	G	H	I	J	K
R1	1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
R2	2	NSE	ACC	EQ	1265	1265	1246.5	1275.3	1247	22	BUY	1167.6105
R3	3	NSE	ADANIENT	EQ	151.85	165.45	151.4	151.85	152.35	25	BUY	141.0465
R4	4	NSE	HDFC	EQ	1805	1826	1805	1809.3	1786.05	1330	BUY	1624.0295
R5	5	NSE	HDFCBANK	EQ	985	988.4	970	991.85	971.85	1333	BUY	854.6115
R6	6	NSE	HEROMOTOCO	EQ	2316	2345	2300	2292.25	2311.8	1348	SHORT	2024.154
R7	7	NSE	HINDALCO	EQ	145.9	147.45	142.45	146.95	143.6	1363	BUY	119.9375

Worksheet: 1-Sheet1 Output 17-21 July


First worksheet After:

_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Rows in Original

First Worksheet After

A

B

C

D

E

F

G

H

I

J

K

R1

1

Exchange

Symbol

Series/Expiry

Open

High

Low

Prev Close

LTP

R2

2

NSE

ACC

EQ

1265

1265

1246.5

1275.3

1247

22

BUY

1167.6105

R4

3

NSE

HDFC

EQ

1805

1826

1805

1809.3

1786.05

1330

BUY

1624.0295

Worksheet: 1-Sheet1 Output 17-21 July


New worksheet after
_____ Workbook: 1.xls ( Using Excel 2007 32 bit )

Rows in Original	New Sheet		B	C	D	E	F	G	H	I	J	K
R1	1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
R3	2	NSE	ADANIENT	EQ	151.85	165.45	151.4	151.85	152.35	25	BUY	141.0465
R5	3	NSE	HDFCBANK	EQ	985	988.4	970	991.85	971.85	1333	BUY	854.6115
R6	4	NSE	HEROMOTOCO	EQ	2316	2345	2300	2292.25	2311.8	1348	SHORT	2024.154
R7	5	NSE	HINDALCO	EQ	145.9	147.45	142.45	146.95	143.6	1363	BUY	119.9375

Worksheet: 1-Sheet1 Output 17-21 July

Macro solution for these posts

https://excelfox.com/forum/showthrea...between-sheets
https://www.excelforum.com/excel-pro...en-sheets.html
http://www.eileenslounge.com/viewtop...bf154f#p271799

Code:

---

Sub MoveSomeDataRowsToNewWorksheetBasedOnConditions()
Rem 1 worksheets data info
Dim Wb1 As Workbook
 Set Wb1 = Workbooks("1.xls")
Dim Ws1 As Worksheet
 Set Ws1 = Wb1.Worksheets.Item(1)
Dim Lr1 As Long: Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row    '    Make Lr Dynamic : https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=11467&viewfull=1#post11467  https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14565&viewfull=1#post14565
Dim arr1DEF() As Variant
 Let arr1DEF() = Ws1.Range("D1:F" & Lr1 & "").Value2
Rem 2 Get the row numbers wanted in the New worksheet and in the first worksheet after
'2a(i) Build the string indicies based on the criterias
Dim str1 As String, str2 As String '  strings to build for  Row numbers  for the two sheets after
 Let str1 = "1": Let str2 = "1"    '  Both Worksheets should have the headers
Dim Cnt
    For Cnt = 2 To Lr1 Step 1
        If arr1DEF(Cnt, 1) = arr1DEF(Cnt, 2) Or arr1DEF(Cnt, 1) = arr1DEF(Cnt, 3) Then '
        ' Do nothing .. For this macro I want to add here the rows which will still be there in the original worksheet  After
        Let str1 = str1 & " " & Cnt
        Else
        '  ..........."...put that data into new worksheet by creating a new sheet in it & remove that data from current sheet........"
        Let str2 = str2 & " " & Cnt ' this will be used for the new worksheet  It is not being used for the first Worksheet after. So that will mean that these rows do not appear in the first worksheet after  ClearContentsing it
        End If
    Next Cnt
'2a(ii)
Dim Rws1() As String, Rws2() As String
 Let Rws1() = Split(str1, " ", -1, vbBinaryCompare): Let Rws2() = Split(str2, " ", -1, vbBinaryCompare)
'2b) Make the "virtical" row indicie array needed in the  "Magic code line"
Dim RwsV1() As String: ReDim RwsV1(1 To UBound(Rws1()) + 1, 1 To 1): Dim RwsV2() As String: ReDim RwsV2(1 To UBound(Rws2()) + 1, 1 To 1)
    For Cnt = 1 To UBound(Rws1()) + 1  '  +1 is needed because the array returned by  Split  is a 1D array starting at 0
    Let RwsV1(Cnt, 1) = Rws1(Cnt - 1)
    Next Cnt
    For Cnt = 1 To UBound(Rws2()) + 1  '  +1 is needed because the array returned by  Split  is a 1D array starting at 0
    Let RwsV2(Cnt, 1) = Rws2(Cnt - 1)
    Next Cnt
Rem 3 Output
Dim Clms() As Variant: Let Clms() = Evaluate("=COLUMN(A:K)") ' ** CHANGE TO SUIT ** This is currently for columns A B C ...K  1 2 3..... 11  For non consequtive columns you can use like  Array("1", "3", "26")  - that last example gives in the new range just columns A C Z from the original worksheet
'3a new Worksheet
 Worksheets.Add After:=Worksheets.Item(1)
 Let ActiveSheet.Name = "New Worksheet"
Dim arrOut() As Variant: Let arrOut() = Application.Index(Ws1.Cells, RwsV2(), Clms()) ' ' The magic code line ---    '  "Magic code line"            http://www.eileenslounge.com/viewtopic.php?p=265384#p265384    http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384          See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172  , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp  for full explanation
 Let Worksheets("New Worksheet").Range("A1").Resize(UBound(arrOut(), 1), 11).Value2 = arrOut() ' We can paste out an array of values in one go to a spreadsheet range. Here A1 is taken as top right which is then resized to the size of the field of data values in arrOut()
'3b) Original worksheet after
 Let arrOut() = Application.Index(Ws1.Cells, RwsV1(), Clms()) ' ' The magic code line ---    '  "Magic code line"            http://www.eileenslounge.com/viewtopic.php?p=265384#p265384    http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384          See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172  , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp  for full explanation
'Ws1.UsedRange.ClearContents
Ws1.Range("A1:K" & Lr1 & "").ClearContents
 Let Ws1.Range("A1").Resize(UBound(arrOut(), 1), 11).Value2 = arrOut()
End Sub

---

Macro for this post
https://excelfox.com/forum/showthrea...4598#post14598

Code:

---

'    Copy row from one workbook to another workbook  based on conditions in another Workbooks
'    https://excelfox.com/forum/showthread.php/2583-Macro-Correction

'    https://excelfox.com/forum/showthread.php/2583-Copy-row-from-one-workbook-to-another-workbook-based-on-conditions-in-another-Workbooks

Sub CopyRow1orRow3fromoneworkbooktoanotherworkbookbasedonconditionsinanotherWorkbooks() '
Rem 1 worksheets info
Dim Ws1 As Worksheet, WsOF As Worksheet, WsBO As Worksheet
 Set Ws1 = Workbooks("1.xls").Worksheets.Item(1): Set WsBO = Workbooks("BasketOrder.xlsx").Worksheets.Item(1): Set WsOF = Workbooks("OrderFormat.xlsx").Worksheets.Item(1)
Dim Lr1 As Long: Let Lr1 = Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row    '    Make Lr Dynamic : https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=11467&viewfull=1#post11467  https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files?p=14565&viewfull=1#post14565
Dim arr1D() As Variant, arr1H() As Variant
 Let arr1D() = Ws1.Range("D1:D" & Lr1 & "").Value2: Let arr1H() = Ws1.Range("H1:H" & Lr1 & "").Value2  '
Rem 2 Do it ...
'2a We want the rows Row 1 or Row 3 in a "virtical" array
Dim RwsV() As String: ReDim RwsV(1 To Lr1 - 1, 1 To 1) ' I column 2 Dimensional Array
Dim Cnt
    For Cnt = 1 To UBound(RwsV(), 1) ' we want a row indicie of  1  or  3  for each  row to be pased to BasketOrder.xlsx
        If arr1H(Cnt + 1, 1) > arr1D(Cnt + 1, 1) Then    ' If column H of 1.xls is greater than column D of 1.xls then
        Let RwsV(Cnt, 1) = "3"                          ' third row of orderformat.xlsx
        ElseIf arr1H(Cnt + 1, 1) < arr1D(Cnt + 1, 1) Then ' If column H of 1.xls is smaller than column D of 1.xls
        Let RwsV(Cnt, 1) = "1"                          ' first row of orderformat.xlsx
        Else
       
        End If
    Next Cnt
Rem 3 output
Dim Clms() As Variant: Let Clms() = Evaluate("=COLUMN(A:U)") ' ** CHANGE TO SUIT ** This is currently for columns A B C ...U  1 2 3..... 21  For non consequtive columns you can use like  Array("1", "3", "26")  - that last example gives in the new range just columns A C Z from the original worksheet
Dim arrOut() As Variant: Let arrOut() = Application.Index(WsOF.Cells, RwsV(), Clms())  ' ' The magic code line ---    '  "Magic code line"            http://www.eileenslounge.com/viewtopic.php?p=265384#p265384    http://www.eileenslounge.com/viewtopic.php?p=265384&sid=39b6d764de41f462fe66f62816e5d789#p265384          See also https://www.excelforum.com/excel-new-users-basics/1099995-application-index-with-look-up-rows-and-columns-arguments-as-vba-arrays.html#post4571172  , http://www.excelfox.com/forum/showthread.php/2145-Excel-VBA-Interception-and-Implicit-Intersection-and-VLookUp  for full explanation
 Let WsBO.Range("A1").Resize(Lr1 - 1, 21).Value2 = arrOut() ' We can paste out an array of values in one go to a spreadsheet range. Here A1 is taken as top right which is then resized to the size of the field of data values in arrOut()
End Sub


---

Post to get URL

post for later use, ( to get URL already now )

Some notes in support of these Threads and posts
This thread , that thread

Hans penultimate

Code:

---

'      https://eileenslounge.com/viewtopic.php?p=272599#p272599      https://eileenslounge.com/viewtopic.php?p=272605#p272605
Sub STEP2() ' Hans penultimate
Dim w1 As Workbook
Set w1 = ActiveWorkbook                    ' CHANGE TO SUIT
Dim ws1 As Worksheet
'Set ws1 = w1.Worksheets.Item(2)
Set ws1 = w1.Worksheets("HansPenultimate") ' CHANGE TO SUIT
Dim MyData As String
Dim lineData() As String, strData() As String, myFile As String
Dim i As Long, rng As Range

'On Error Resume Next

'myFile = "C:\Users\WolfieeeStyle\Desktop\NSEVAR.txt"
myFile = ThisWorkbook.Path & "\NSEVAR.txt" ' CHANGE TO SUIT
Open myFile For Binary As #1
MyData = Space$(LOF(1))
Get #1, , MyData
Close #1

lineData() = Split(MyData, vbNewLine)
Set rng = ws1.Range("A2")

For i = 0 To UBound(lineData)
   
    strData = Split(lineData(i), ",")
     
    rng.Offset(i, 0).Resize(1, UBound(strData) + 1) = strData
   
Next
'    ws1.Range("A:A").Select
'
'
'    Selection.TextToColumns Destination:=ws1.Range("A1"), DataType:=xlDelimited, _
'        TextQualifier:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=False, _
'        Semicolon:=False, Comma:=True, Space:=False, Other:=False, OtherChar _
'        :=",", FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), Array(5, _
'        1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1)), _
'        TrailingMinusNumbers:=True
   
ws1.Columns("A:Z").AutoFit


ws1.Range("A1").Select

w1.Save

End Sub


---

My modifed from last macro

Code:

---

Sub TextFileToExcel_GroundhogDay12()  '  http://www.eileenslounge.com/viewtopic.php?f=30&t=35100          http://www.eileenslounge.com/viewtopic.php?p=268809#p268809
Rem 1 Workbooks,  Worksheets info
Dim Wb As Workbook, Ws As Worksheet
 Set Wb = Workbooks("macro.xlsb")      ' CHANGE TO SUIT
' Set Ws = Wb.Worksheets.Item(2)      ' second worksheet
 Set Ws = Wb.Worksheets("Mylastmacro") ' CHANGE TO SUIT
Dim lr As Long: Let lr = Ws.Range("A" & Ws.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. )
Dim NxtRw As Long
    If lr = 1 And Ws.Range("A1").Value = "" Then
    Let NxtRw = 1      '  If there is no data in the worksheet we want the first row to be the start row
    Else
    Let NxtRw = lr + 1 '  If there is data in the worksheet, we want the data to be posted after the last used row
    End If
Rem 2 Text file info
' 2a) get the text file as a long single string
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 & "\" & "NSEVAR.txt"  ' CHANGE TO SUIT    From vixer zyxw1234  : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629    DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic
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 has to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine )
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1    '  +1 is nedeed as the  Split Function  returns indicies 0 1 2 3 4 5  etc...
' we can now make an array for all the rows, and we know our columns are A-J = 10 columns
Dim arrOut() As String: ReDim arrOut(1 To RwCnt, 1 To 10)

Rem 3 An array is built up by _....
Dim Cnt As Long
    For Cnt = 1 To RwCnt '              _.. considering each row of data
    Dim arrClms() As String
    Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare)  '  ___.. splitting each row into columns by splitting by the comma
    Dim Clm As Long  '
        For Clm = 1 To UBound(arrClms()) + 1
        Let arrOut(Cnt, Clm) = arrClms(Clm - 1)
        Next Clm
    Next Cnt

Rem 4  Finally the array is pasted to the worksheet at the next free row
' Let Ws.Range("A" & NxtRw & "").Resize(RwCnt, 10).Value2 = arrOut()
 Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = arrOut()
' Ws.Columns("A:J").AutoFit
Rem 5 to remove  http://www.eileenslounge.com/viewtopic.php?p=272606&sid=7e8ad1b708dd49a811498ccac6b1e092#p272606    .....    when i click on any cell that has output  there is an option numbers stored as text, convert to numbers,help on this error,ignore error,edit in formula bar,error checking options(these are the options coming)
' Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISERROR(1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "),A" & NxtRw & ":J" & RwCnt & ",1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "))")
' Let Ws.Range("B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISERROR(1*B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "),B" & NxtRw & ":D" & RwCnt & ",1*B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "))")
' Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISNUMBER(1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "),1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & ",A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "))")

End Sub

---

Hans final macro in this thread

Code:

---

Sub STEP2_() ' to remove  http://www.eileenslounge.com/viewtopic.php?p=272606&sid=7e8ad1b708dd49a811498ccac6b1e092#p272606    .....    when i click on any cell that has output  there is an option numbers stored as text, convert to numbers,help on this error,ignore error,edit in formula bar,error checking options(these are the options coming)
    Dim w1 As Workbook
    Dim ws1 As Worksheet
    Dim MyData As String
    Dim lineData() As String, strData() As String, myFile As String
    Dim i As Long, rng As Range

    'myFile = "C:\Users\WolfieeeStyle\Desktop\NSEVAR.txt"
    myFile = ThisWorkbook.Path & "\NSEVAR.txt"

    Open myFile For Binary As #1
    MyData = Space$(LOF(1))
    Get #1, , MyData
    Close #1

    lineData() = Split(MyData, vbNewLine)
    Set w1 = ActiveWorkbook
    Set ws1 = w1.Worksheets.Item(2)
    With ws1.Range("A2").Resize(UBound(lineData) + 1)
        .Value = Application.Transpose(lineData)
        .TextToColumns Destination:=ws1.Range("A2"), DataType:=xlDelimited, _
            TextQualifier:=xlDoubleQuote, Comma:=True, _
            FieldInfo:=Array(Array(1, 1), Array(2, 1), Array(3, 1), Array(4, 1), _
            Array(5, 1), Array(6, 1), Array(7, 1), Array(8, 1), Array(9, 1), Array(10, 1))
    End With
End Sub


---

Post for later use, ( to get URL already now ) - .

testing

---

“Moderator” Notice

**I am Banning you to prevent you making any more postings here of the type you have been making here and elsewhere under hundreds of different user names at many of the English speaking Excel and Office help forums for the last couple of years.

The type of post that you have been posting suggest that
_ You may be one person or a team of many people working at something organised like a Call Centre.
_ You have almost no understanding of the English language
_ You may not have a computer and may have no access to Excel
_ You have no interest in Excel or Excel VBA
_ You have almost no knowledge or interest in any of the questions that you are asking
_ You may be simply offering a service of posting other peoples questions and supplying them with any answers you get.
_ You may be part of the development of a question asking and Replying Bot

_ In some cases, something extremely simple to understand, has been explained to you in great detail , even graphically, such that even a small mentally handicapped child could understand it and remember it. Despite this, you continually ask exactly the same question over and over again: If you are part of a team interested in only posting questions and taking the answer, then you are very badly organised,
Or
There is no real intelligence behind what is producing your questions and posts
_ One of the things you consistently do after receiving a macro is to delete all explanations, explaining 'comments and all files associated, and indeed it appears as if you try to remove almost all record of the coding and the question and answer. This further encourages the posting of the same or similar questions over and over again.

Whatever you are attempting to do, it appears to be extremely, almost insanely, inefficient ,
compared to
a single person with a computer and Excel, and a minimum of basic Excel VBA knowledge trying to achieve the same.

The main reason for the ban is
Whatever you are attempting to do, it is requiring 10-100 times more time than is typically required of helpers at a forum. All indications are that what you are doing will fail to achieve anything, and is therefore a total waste of everyone’s time. At excelfox, the current small number of helpers have only a limited amount of time, but even if we had more members, excelfox would not be the place for you##

These are some suggestions, from me, on how you should continue
_ If you intend to continue, regardless of any of my previous suggestions, in postings of the type as you have done in the past, then you should think about making some changes to your wording, introduce some new canned replies, possibly organise a new set of similar questions and post at the major forums, such as mrexcel.com, excelforum.com, ozgrid.com
_ If you wish to make a career out of posting questions and getting answers with out having any real intentions of thinking about anything, then excelfox is not the forum for you to post in. Most of the smaller forums are not the place for you. The larger forums may be able to accommodate you, if you give at least some thought to making it not quite so obvious as you have been doing. Many people do the such. At least half the traffic at such forums originates from such. I have passed many people on to such forums and they are making a successful career based on passing on the work done for them by helpers at the major forums. Such is actually encouraged, all be it , not openly.
_ If you have not understood most of this Moderator Notice , then your first priority should be to improve on your English. Indeed, your apparent understanding and ability in communicating in English suggests that you will achieve nothing whatsoever and fail completely in anything at all involving communicating in English.

_ If you are, as you sometimes told me, actively working on an important personal problem requiring VBA , then you are doing it totally wrongly: You have been on the project already for at least two years and have a mixed up set of codings produced by many different people. Some work . Some don’t. You have not the slightest idea or understanding of any of the codings. You will never be able to use them to any effect. If , on the other hand, you had a computer, with Excel, and spent a few weeks learning VBA, and then carefully studied all the macros that you have been given, then you would be able to answer most of your further questions, and would have at least a chance of being able to use the codings effectively.

---

##The main purpose of the question section of excelfox is approximately the following:
_1. Promote and improve the understanding of Excel and Excel VBA.
_2. Help people who get stuck on a problem and/or help people who are unsure how to proceed in solving a problem using Excel and Excel VBA.

Your objectives??
I do not know what the true reason is behind your postings. I can’t believe anything you say is your purpose, since you have lied and contradicted yourself in the past. The only thing we know 100% for sure is that your posting types are not for any of the purposes for which the question section of excelfox is intended.
You have had the benefit of the doubt given to you now very many times. You have had lots of chances.
You may be able to continue at some of the major forums, where some people are happy to continue to spend time to answer similar questions from the same source.
I do not think you get any more replies to the types of postings you have been making at excelfox or at any other of the smaller English speaking Forums. You are wasting your time making any such posts from now on.
**I am Banning you, not as any form of punishment, but purely as in the past , it has proven to be the only way to prevent you wasting yours and other peoples time with your postings.
I do wish you luck and success with what ever it is you are attempting to do. But you should not be doing it at excelfox.

Macro in support of this Thread and posts.
This thread ,
that thread
http://www.eileenslounge.com/viewtop...272682#p272682
https://eileenslounge.com/viewtopic....272706#p272706
( and probably a dozen more in the next few months.... )

Code:

---

Sub TextFileToExcel_GroundhogDay12b()  '  http://www.eileenslounge.com/viewtopic.php?f=30&t=35100          http://www.eileenslounge.com/viewtopic.php?p=268809#p268809
Rem 1 Workbooks,  Worksheets info
Dim Wb As Workbook, Ws As Worksheet
 Set Wb = Workbooks("macro.xlsb")      ' CHANGE TO SUIT
 Set Ws = Wb.Worksheets.Item(2)      ' second worksheet
' Set Ws = Wb.Worksheets("Mylastmacro") ' CHANGE TO SUIT
Dim lr As Long: Let lr = Ws.Range("A" & Ws.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. )
Dim NxtRw As Long
    If lr = 1 And Ws.Range("A1").Value = "" Then
    Let NxtRw = 2      '  If there is no data in the worksheet we want the second row to be the start row
    Else
    Let NxtRw = lr + 1 '  If there is data in the worksheet, we want the data to be posted after the last used row
    End If
Rem 2 Text file info
' 2a) get the text file as a long single string
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 & "\" & "NSEVAR.txt"  ' CHANGE TO SUIT    From vixer zyxw1234  : http://www.eileenslounge.com/viewtopic.php?f=30&t=34629    DF.txt https://app.box.com/s/gw941dh9v8sqhvzin3lo9rfc67fjsbic  NSEVER.txt: https://app.box.com/s/245h7i5nh6an8vw08g8t08fvu30ylih2
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 has to be a string of exactly the right length
Get #FileNum, , TotalFile
Close #FileNum
' 2b) Split into wholes line _ splitting the text file into rows by splitting by vbCr & vbLf ( Note vbCr & vbLf = vbNewLine )
Dim arrRws() As String: Let arrRws() = Split(TotalFile, vbCr & vbLf, -1, vbBinaryCompare)
Dim RwCnt As Long: Let RwCnt = UBound(arrRws()) + 1    '  +1 is nedeed as the  Split Function  returns indicies 0 1 2 3 4 5  etc...
' we can now make an array for all the rows, and we know our columns are A-J = 10 columns
Dim arrOut() As String: ReDim arrOut(1 To RwCnt, 1 To 10)

Rem 3 An array is built up by _....
Dim Cnt As Long
    For Cnt = 1 To RwCnt '              _.. considering each row of data
    Dim arrClms() As String
    Let arrClms() = Split(arrRws(Cnt - 1), ",", -1, vbBinaryCompare)  '  ___.. splitting each row into columns by splitting by the comma
    Dim Clm As Long  '
        For Clm = 1 To UBound(arrClms()) + 1
        Let arrOut(Cnt, Clm) = arrClms(Clm - 1)
        Next Clm
    Next Cnt

Rem 4  Finally the array is pasted to the worksheet at the next free row
' Let Ws.Range("A" & NxtRw & "").Resize(RwCnt, 10).Value2 = arrOut()
 Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = arrOut()
' Ws.Columns("A:J").AutoFit
Rem 5 to remove  http://www.eileenslounge.com/viewtopic.php?p=272606&sid=7e8ad1b708dd49a811498ccac6b1e092#p272606    .....    when i click on any cell that has output  there is an option numbers stored as text, convert to numbers,help on this error,ignore error,edit in formula bar,error checking options(these are the options coming)
 Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISNUMBER(1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "),1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & ",A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "))")
' Let Ws.Range("A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISERROR(1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "),A" & NxtRw & ":J" & RwCnt & ",1*A" & NxtRw & ":J" & RwCnt + (NxtRw - 1) & "))")
' Let Ws.Range("B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "").Value2 = Evaluate("=IF(B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "="""","""",IF(ISERROR(1*B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "),B" & NxtRw & ":D" & RwCnt & ",1*B" & NxtRw & ":D" & RwCnt + (NxtRw - 1) & "))")

End Sub

---

_.___________________________


Macro.xlsb : https://app.box.com/s/uwpnuqmnc1uxpl0wpfrbh52iqr1enfcv
NSEVER.txt : https://app.box.com/s/245h7i5nh6an8vw08g8t08fvu30ylih2

In support of this Thread, ( more out of my interests, its totally lost on the OP …. https://excelfox.com/forum/showthrea...lsx-to-notepad

As done many times before….
In Notepad
https://imgur.com/eOUaOZv
https://i.imgur.com/eOUaOZv.jpg

Reducing the size , for convenience …
https://imgur.com/FvCn18d
https://i.imgur.com/FvCn18d.jpg

Using a macro we have used many times…

Code:

---

Sub Sept22()  '  https://excelfox.com/forum/showthread.php/2640-Macro-Correction-converting-data-from-xlsx-to-notepad    https://excelfox.com/forum/showthread.php/2577-Appendix-Thread-(-Codes-for-other-Threads-(-Avinash-)-)?p=14970&viewfull=1#post14970
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 & "\" & "AlertExFoxReduced.txt" '
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

---

The macro above gives us:

Code:

---

"NSE" & "," & "15083" & "," & "6" & "," & Chr(62) & "=" & "," & "34300" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & "," & vbLf & "NSE" & "," & "404" & "," & "6" & "," & Chr(62) & "=" & "," & "56700" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & "," & vbLf & "NSE" & "," & "2181" & "," & "6" & "," & Chr(62) & "=" & "," & "1283170" & "," & "A" & "," & "," & "," & "," & "," & "GTT" & "," & vbLf

---

So we have what looks like a vbLf for the line separator

---

Share ‘Alert.ExForum.txt’ : https://app.box.com/s/4gn2nlnmnwda8kalp9yugn2j4qvh0891
Share ‘Alert. (1)ExFox.txt’ : https://app.box.com/s/btcb75mogjarlu1o55aq9ncj8x9mx91i