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") '
Bookmarks