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

[DocAElstein]

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( )

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

[DocAElstein]

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

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

[DocAElstein]

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

'    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