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
Bookmarks