Tests Copying, Pasting, API Cliipboard issues. and Rough notes on Advanced API stuff

Test blog post, and function needed for other posts…


http://www.excelfox.com/forum/showth...ge40#post12673

Title….

I have sometimes needed to check for a specific file type in a list of files and folders. Often a simple search for the characters in the extension, ( for example .doc for a Word 2003 file )
I had a more difficult situation where with multiple file types and folders which included parts in the text string which could be mistakenly found in a search fir the extension part.

The logic behind the simple functions below is as follows.
A string is taken in, strIn.
The function contains a list of all extensions being searched for. If an extension is found in the supplied string, then that extension is the string returned by the function. ( The first character in the extension string will always be a . )
If no match is found then the string of
“0” & strIn ' note: that first character is a zero
is retuned

Notes:
In the list, the longest character length extension are at the beginning. This avoids a part of the longer character extension being mistaken as a shorter character extension, since the longest character length extensions will be detected firstly .

Code:

---

Sub TestieGetMyExtension()
 MsgBox prompt:=GetMyExtension("a")
 MsgBox prompt:=GetMyExtension("1394ohci.sys")
 MsgBox prompt:=GetMyExtension("61883.inf_amd64_fb51a2f8b89aa4a7")
 MsgBox prompt:=GetMyExtension("wiaky003.inf_loc")
 MsgBox prompt:=GetMyExtension("acpi.PNF")
 MsgBox prompt:=GetMyExtension("bcmwdidhdpcie.inf_amd64_977dcc915465b0e9")

End Sub
Public Function GetMyExtension(ByVal strIn As String) As String
Dim MyExts() As Variant
 Let MyExts() = Array("inf_loc", "sys.mui", "dll.mui", "sys", "dll", "bin", "cpa", "bag", "xml", "gdl", "cab", "ini", "cat", "inf", "pnf", "gpd", "exe", "sam", "hlp", "ntf", "ppd", "tbl", "icc", "dat", "dpb", "cty", "msc", "xst", "vp", "js")
Dim Stear As Variant
    For Each Stear In MyExts()
    Dim Lenf As Long: Let Lenf = Len(Stear)
        If Len(strIn) > Lenf + 1 Then ' Length of  strIn  must be at least 2 more characters longer than the extension from the array above ,  like  x.sys  so greater than the length of like the length of  .sys  which has the length of  (length of  sys )+1
        Dim LstBt As String
        Let LstBt = Right(strIn, Lenf)
            If "." & UCase(LstBt) = "." & UCase(Stear) Then
            Let GetMyExtension = Stear
            Exit Function ' end of function with sucessful file type find - give file type to  function return string value
            Else
            ' not this file type in last characters
            End If
        Else
        ' then input string is too short to include the current extension string in  Stear
        End If
    Next Stear
 Let GetMyExtension = "0" & strIn ' This allows a simple check for like  If Left(GetMyExstension(kjshdkjs,kiafh_.kjfh, 1)= 0 Then  to determine if we have a file type like we want
End Function


---

Code:

---

Sub CountMissingFilesFromOriginalInNewList2()
Dim WsDS As Worksheet: Set WsDS = Worksheets("DriverStoreCompareMarz17 2020") '    =ANZAHL2(H3:J4396)    =ANZAHL2(D3:F4396)
Dim RngDS1 As Range, RngDS2 As Range  '
 Set RngDS1 = WsDS.Range("G3:J4396"): Set RngDS2 = WsDS.Range("C3:F4396") ' A bit back to front 1 is right columns original , 2 is left columns new from Marz 2020

Dim Cnt1 As Long, cnt2 As Long, Rng As Range, strRej As String
    For Each Rng In RngDS1
        If Not Rng.Value = "" And Rng.Interior.ColorIndex = -4142 And Not Left(GetMyExtension(Rng.Value), 1) = "0" Then
        ' Not empty cell  And  No interior colour And  any file extension
        Let Cnt1 = Cnt1 + 1
        Else
            If Not Rng.Value = "" And Rng.Interior.ColorIndex = -4142 Then
            Let strRej = strRej & Rng.Value & vbCr & vbLf
            Let cnt2 = cnt2 + 1
            Else
            End If
        End If
    Next Rng
 MsgBox prompt:="Missing is  " & Cnt1 & vbCr & vbLf & vbCr & vbLf & "Not counted, not coloured: " & vbCr & vbLf & strRej & vbCr & vbLf & "Changed Folder names is  " & cnt2
 Debug.Print "Missing is  " & Cnt1 & vbCr & vbLf & vbCr & vbLf & "Not counted, not colured: " & vbCr & vbLf & strRej & vbCr & vbLf & "Changed Folder names is  " & cnt2
End Sub
Sub CountNewFilesFromInNewList2()
Dim WsDS As Worksheet: Set WsDS = Worksheets("DriverStoreCompareMarz17 2020") '    =ANZAHL2(H3:J4396)    =ANZAHL2(D3:F4396)
Dim RngDS1 As Range, RngDS2 As Range  '
 Set RngDS1 = WsDS.Range("G3:J4396"): Set RngDS2 = WsDS.Range("C3:F4396") ' A bit back to front 1 is right columns original , 2 is left columns new from Marz 2020

Dim Cnt1 As Long, cnt2 As Long, Rng As Range, strRej As String, strNew As String
    For Each Rng In RngDS2
        If Not Rng.Value = "" And Rng.Interior.ColorIndex = -4142 And Not Left(GetMyExtension(Rng.Value), 1) = "0" Then
        ' conditions to be met are  not empty  And  no interior colour  And  any file extension
        Let Cnt1 = Cnt1 + 1
        Let strNew = strNew & Rng.Value & vbCr & vbLf
        Else
            If Not Rng.Value = "" And Rng.Interior.ColorIndex = -4142 Then
            Let strRej = strRej & Rng.Value & vbCr & vbLf
            Let cnt2 = cnt2 + 1
            Else
            End If
        End If
    Next Rng
 MsgBox prompt:="New is  " & Cnt1 & vbCr & vbLf & "New are  " & strNew
 Debug.Print "New is  " & Cnt1 & vbCr & vbLf & "New are  " & strNew
' MsgBox prompt:="Missing is  " & Cnt1 & vbCr & vbLf & vbCr & vbLf & "Not counted, not coloured: " & vbCr & vbLf & strRej & vbCr & vbLf & "Changed Folder names is  " & cnt2
' Debug.Print "Missing is  " & Cnt1 & vbCr & vbLf & vbCr & vbLf & "Not counted, not colured: " & vbCr & vbLf & strRej & vbCr & vbLf & "Changed Folder names is  " & cnt2
End Sub

---

ExplorerBefore DriverStore Comparison Marz 2020.xlsm : https://app.box.com/s/oy8pnuizk6xng1msqlsxho7l8e0bi0t8
Explorer Before DriverStore Comparison Marz 2020.xlsm : https://app.box.com/s/4zx7b8d2gwjix7u68zit6o22x7q0kwm2

In support of this post
http://www.excelfox.com/forum/showth...ge41#post12675
First use of Dictionary alternative.
The following two macros give similar results. The first is the big Case Else macro and the second the first use of a Dictionary, Dik, alternative.

Code:

---

Option Explicit
' Marz 2020
Private Sub FileTypesHere_And_MaybeAlsoInDeviceManager()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim Rng As Range: Set Rng = Ws.Range("D4:E300") 'Set Rng = Ws.Range("F4:G300") ' Set Rng = Ws.Range("D4:E75")
'Dim arrFiles() As Variant: Let arrFiles() = Rng.Value2
Rem 2 File extension types
Dim Ddl As Long, Sys As Long, Bin As Long, Cpa As Long, Vp As Long, Els As Long
Dim Bag As Long, Xml As Long, Js As Long, Gdl As Long, Cab As Long, Ini As Long
Dim Cat As Long, Inf As Long, Pnf As Long, Gpd As Long, Exe As Long
Dim Ddl2 As Long, Sys2 As Long, Bin2 As Long, Cpa2 As Long, Vp2 As Long
Dim Bag2 As Long, Xml2 As Long, Js2 As Long, Gdl2 As Long, Cab2 As Long, Ini2 As Long
Dim Cat2 As Long, Inf2 As Long, Pnf2 As Long, Gpd2 As Long, Exe2 As Long
Dim Dpb As Long, Ppd As Long
Dim Dpb2 As Long, Ppd2 As Long
Rem 3 Looping
Dim ClCnt As Long, RwCnt As Long
Dim rngStr As Range
    For Each rngStr In Rng
'    For RwCnt = 1 To UBound(arrFiles(), 1)
'        For ClCnt = 1 To UBound(arrFiles(), 2)
            'If arrFiles(RwCnt, ClCnt) = "" Then
            If rngStr.Value = "" Then
            ' Empty cell, so do nothing
            Else ' Time to look at cell value
'                If Left(arrFiles(RwCnt, ClCnt), 3) = "C:\" And InStr(4, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                'If InStr(2, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                If InStr(2, rngStr.Value, ".", vbBinaryCompare) > 1 Then ' use some criteria to check we have a file path
                ' Get the extension
                Dim Xtn As String
                'Let Xtn = Mid(arrFiles(RwCnt, ClCnt), (InStr(2, arrFiles(RwCnt, ClCnt), ".", vbBinaryCompare) + 1))
                Let Xtn = Mid(rngStr.Value, (InStr(2, rngStr.Value, ".", vbBinaryCompare) + 1))
                    Select Case UCase(Xtn)
                    Case "SYS"
                      Let Sys = Sys + 1: If rngStr.Font.Color <> 0 Then Let Sys2 = Sys2 + 1
                    Case "DLL"
                      Let Ddl = Ddl + 1: If rngStr.Font.Color <> 0 Then Let Ddl2 = Ddl2 + 1
                    Case "BIN"
                      Let Bin = Bin + 1: If rngStr.Font.Color <> 0 Then Let Bin2 = Bin2 + 1
                    Case "CPA"
                      Let Cpa = Cpa + 1: If rngStr.Font.Color <> 0 Then Let Cpa2 = Cpa2 + 1
                    Case "VP"
                      Let Vp = Vp + 1: If rngStr.Font.Color <> 0 Then Let Vp2 = Vp2 + 1
                    'Dim Bag As Long, Xml As Long, Js As Long, Gdl As Long, Cab As Long, Ini As Long, Cat As Long
                    Case "BAG"
                      Let Bag = Bag + 1: If rngStr.Font.Color <> 0 Then Let Bag2 = Bag2 + 1
                    Case "XML"
                      Let Xml = Xml + 1: If rngStr.Font.Color <> 0 Then Let Xml2 = Xml2 + 1
                    Case "JS"
                      Let Js = Js + 1: If rngStr.Font.Color <> 0 Then Let Js2 = Js2 + 1
                    Case "GDL"
                      Let Gdl = Gdl + 1: If rngStr.Font.Color <> 0 Then Let Gdl2 = Gdl2 + 1
                    Case "CAB"
                      Let Cab = Cab + 1: If rngStr.Font.Color <> 0 Then Let Cab2 = Cab2 + 1
                    Case "INI"
                      Let Ini = Ini + 1: If rngStr.Font.Color <> 0 Then Let Ini2 = Ini2 + 1
                    Case "CAT"
                      Let Cat = Cat + 1: If rngStr.Font.Color <> 0 Then Let Cat2 = Cat2 + 1
                    ' Inf As Long, Pnf As Long, Gpd As Long, Exe as long
                    Case "INF"
                      Let Inf = Inf + 1: If rngStr.Font.Color <> 0 Then Let Inf2 = Inf2 + 1
                    Case "PNF"
                      Let Pnf = Pnf + 1: If rngStr.Font.Color <> 0 Then Let Pnf2 = Pnf2 + 1
                    Case "GPD"
                      Let Gpd = Gpd + 1: If rngStr.Font.Color <> 0 Then Let Gpd2 = Gpd2 + 1
                    Case "EXE"
                      Let Exe = Exe + 1: If rngStr.Font.Color <> 0 Then Let Exe2 = Exe2 + 1
                    ' Dim Dpb As Long, Ppd As Long
                    Case "DPB"
                      Let Dpb = Dpb + 1: If rngStr.Font.Color <> 0 Then Let Dpb2 = Dpb2 + 1
                    Case "PPD"
                      Let Ppd = Ppd + 1: If rngStr.Font.Color <> 0 Then Let Ppd2 = Ppd2 + 1
                    Case Else
                      Debug.Print "Case Else  " & rngStr.Value ' arrFiles(RwCnt, ClCnt)
                      Let Els = Els + 1
                    End Select
                Else ' not a file path, or rather not a  .  in
                Dim Fldr As Long: Let Fldr = Fldr + 1
                End If
            End If
'        Next ClCnt
'    Next RwCnt
    Next rngStr
Rem 4 output
Debug.Print "sys  " & Sys & " (" & Sys2 & ")"
Debug.Print "dll  " & Ddl & " (" & Ddl2 & ")"
Debug.Print "bin  " & Bin & " (" & Bin2 & ")"
Debug.Print "cpa  " & Cpa & " (" & Cpa2 & ")"
Debug.Print "vp  " & Vp & " (" & Vp2 & ")"
Debug.Print "els  " & Els
'Dim Bag As Long, Xml As Long, Js As Long, Gdl As Long, Cab As Long, Ini As Long, Cat As Long
Debug.Print "bag  " & Bag & " (" & Bag2 & ")"
Debug.Print "xml  " & Xml & " (" & Xml2 & ")"
Debug.Print "js  " & Js & " (" & Js2 & ")"
Debug.Print "gdl  " & Gdl & " (" & Gdl2 & ")"
Debug.Print "cab  " & Cab & " (" & Cab2 & ")"
Debug.Print "ini  " & Ini & " (" & Ini2 & ")"
Debug.Print "cat  " & Cat & " (" & Cat2 & ")"
' Inf As Long, Pnf As Long, Gpd As Long, Exe as long
Debug.Print "inf  " & Inf & " (" & Inf2 & ")"
Debug.Print "pnf  " & Pnf & " (" & Pnf2 & ")"
Debug.Print "gpd  " & Gpd & " (" & Gpd2 & ")"
Debug.Print "exe  " & Exe & " (" & Exe2 & ")"
' Dim Dpb As Long, Ppd As Long
Debug.Print "dpb  " & Dpb & " (" & Dpb2 & ")"
Debug.Print "ppd  " & Ppd & " (" & Ppd2 & ")"
Debug.Print "Total files is  " & Sys + Ddl + Bin + Cpa + Vp + Bag + Xml + Js + Gdl + Cab + Ini + Cat + Inf + Pnf + Gpd + Exe + Dpb + Ppd
Debug.Print "Things with no  .  are  " & Fldr
End Sub

Private Sub FilesTypeHereFromFunction()
Rem 1 Worksheets info
Dim Ws As Worksheet: Set Ws = Me
Dim rng2BSrchd As Range: Set rng2BSrchd = Ws.Range("D4:E260")
Rem 2 A Dik for the extensions and count thereof
'2a) Make the Dik
Dim Dik As Object: Set Dik = CreateObject("Scripting.Dictionary")
Dik.CompareMode = vbTextCompare ' make case insensitive, probably not necersary in our case as we do all comares at UCase to make it already case insensitive
'2b) Fill the Dik
Dim rngStr As Range
    For Each rngStr In rng2BSrchd
        If rngStr.Value = "" Then
        ' empty cell  Do nothing
        Else
        Dim FkBk As String
        Let FkBk = GetMeExtension(Trim(rngStr.Value))
            If Left(FkBk, 1) = "0" Then
            Dim Fldrs As String
            Let Fldrs = Fldrs & rngStr.Value & vbCr & vbLf
            Else ' we have an extension of a type we may or may not have had already
                If Dik.Exists("" & FkBk & "") Then
                Let Dik.Item("" & FkBk & "") = Dik.Item("" & FkBk & "") + 1 ' add to count of this extension, - the count is actually held as the item
                Else
                Dik.Add Key:="" & FkBk & "", Item:=1 ' I create an item who's key is the extension string, and make item the count of it,  1 here initially
                End If
            End If
        End If
   
    Next rngStr
'2c) output from Dik
Dim Kys() As Variant, Itms() As Variant
 Let Kys() = Dik.Keys(): Let Itms() = Dik.Items()
Dim Cnt As Long
    For Cnt = 0 To Dik.Count - 1 ' Note Dictionaries by default start at 0, but the count is the actual number, so  Count-1  is the last indicee and  0  is the first
    Debug.Print Kys()(Cnt) & " " & Itms()(Cnt)
    Next Cnt

End Sub

---

In support of this post
http://www.excelfox.com/forum/showth...ge41#post12675

Code:

---

'  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page41#post12675
Sub NewCmdVNewDD()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim Wscmd As Worksheet: Set Wscmd = Worksheets("Command17Marz")
Dim Rngcmd As Range ' dont actually need this, since I make a selection.. but I can use it to check the selection
 Set Rngcmd = Wscmd.Range("D4:E260")
    If Intersect(Rngcmd, Selection) Is Nothing Then MsgBox prompt:="oops": Exit Sub
Dim WsDD As Worksheet: Set WsDD = Worksheets("DDAllComparison")
Dim RngDD As Range
 Set RngDD = WsDD.Range("E4:E680")
Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
' take each cell in cmd range and find it in DD range
Dim Rng As Range
    For Each Rng In Selection
        If Rng <> "" Then
        Dim FndRng As Range ' range file cell found in DD
        Set FndRng = RngDD.Find(what:=Rng.Value, After:=RngDD.Cells.Item(1), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndRng Is Nothing Then ' we have a match that may or may not be the only one in DD, I am assuming it is the only one in cmd, at least in the selection I am using
                Wscmd.Activate: Rng.Select
                Let Rng.Font.ColorIndex = ClrIdx
                Application.Wait (Now + TimeValue("00:00:01"))
                   
                    Do While Not FndRng Is Nothing
                    WsDD.Activate: FndRng.Select
                    Let FndRng.Font.ColorIndex = ClrIdx
                    Application.Wait (Now + TimeValue("00:00:01"))
                    Set FndRng = WsDD.Range("E" & FndRng.Row + 1 & ":E680").Find(what:=Rng.Value, After:=WsDD.Range("E680"), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)  '  https://stackoverflow.com/questions/49094391/excel-vba-range-findnext-v-range-find-what-have-i-missed/49181464#49181464
                  Loop ' looping for next match ======
            Else ' no cell value match
            End If
        Else ' case rng has not text in it
        End If
    Next Rng  ' Each Rng In RngDD ---------------|
End Sub


---

Macro for this post solution, ( written by the son of God )
http://www.excelfox.com/forum/showth...ll=1#post12897

Code:

---

Sub conditionally_delete3() '  http://www.excelfox.com/forum/showthread.php/2436-conditionally-delete-entire-row?p=12893&viewfull=1#post12893
Rem 1 Worksheets info
Dim Wb1 As Workbook, Wb2 As Workbook, Ws1 As Worksheet, Ws2 As Worksheet
 Set Wb1 = Workbooks("STEP1U.xlsb") ' Workbooks("sample1.xlsx") ' Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Upstox\STEP1U.xlsb")
 Set Ws1 = Wb1.Worksheets.Item(1) ' worksheet of first tab
 Set Wb2 = Workbooks("1.xls") ' Workbooks("sample2.xlsx") '  Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
 Set Ws2 = Wb2.Worksheets.Item(1) ' worksheet of first tab
'1b Ranges
Dim Rng1A As Range, Rng2B As Range
 Set Rng1A = Ws1.Range("A2:A" & Ws1.Range("A" & Ws1.Rows.Count & "").End(xlUp).Row & "")
 Set Rng2B = Ws2.Range("B2:B" & Ws2.Range("B" & Ws2.Rows.Count & "").End(xlUp).Row & "")

Rem 2 Delete an entire row in Ws2 if value in column B is not anywhere in column A of Ws1
Dim Rws As Long
    For Rws = Ws2.Range("B" & Ws2.Rows.Count & "").End(xlUp).Row To 2 Step -1
    Dim rngFnd As Range
    Set rngFnd = Rng1A.Find(what:=Ws2.Range("B" & Rws & "").Value, After:=Rng1A.Item(1), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)  '  https://stackoverflow.com/questions/49094391/excel-vba-range-findnext-v-range-find-what-have-i-missed/49181464#49181464
        If rngFnd Is Nothing Then ' The value from column B in Ws2 was not found in column A of Ws1
        Ws2.Range("B" & Rws & "").EntireRow.Delete Shift:=xlUp
        Else
        ' The value from column B in Ws2 was found in column A of Ws1 so do nothing
        End If
    Next Rws
   
'    Wb1.Save
'    Wb1.Close
'    Wb2.Save
'    Wb2.Close
End Sub

---

---

1.xls: https://app.box.com/s/th2xzmkh7rnfr4qf4dho1kpgudndm073

In support of these posts

http://www.excelfox.com/forum/showth...ge41#post12676
http://www.excelfox.com/forum/showth...ge41#post12677
http://www.excelfox.com/forum/showth...ge41#post12678

Code:

---

'  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page41#post12676
Sub NewCmdVNewDD()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim Wscmd As Worksheet: Set Wscmd = Worksheets("Command17Marz")
Dim Rngcmd As Range ' dont actually need this, since I make a selection.. but I can use it to check the selection
 Set Rngcmd = Wscmd.Range("D4:E260")
    If Intersect(Rngcmd, Selection) Is Nothing Then MsgBox prompt:="oops": Exit Sub
Dim WsDD As Worksheet: Set WsDD = Worksheets("DDAllComparison")
Dim RngDD As Range
 Set RngDD = WsDD.Range("E4:E680")
Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
' take each cell in cmd range and find it in DD range
Dim Rng As Range
    For Each Rng In Selection
        If Rng <> "" Then
        Dim FndRng As Range ' range file cell found in DD
        Set FndRng = RngDD.Find(what:=Rng.Value, After:=RngDD.Cells.Item(1), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndRng Is Nothing Then ' we have a match that may or may not be the only one in DD, I am assuming it is the only one in cmd, at least in the selection I am using
                Wscmd.Activate: Rng.Select
                Let Rng.Font.ColorIndex = ClrIdx
                Application.Wait (Now + TimeValue("00:00:01"))
                   
                    Do While Not FndRng Is Nothing
                    WsDD.Activate: FndRng.Select
                    Let FndRng.Font.ColorIndex = ClrIdx
                    Application.Wait (Now + TimeValue("00:00:01"))
                    Set FndRng = WsDD.Range("E" & FndRng.Row + 1 & ":E680").Find(what:=Rng.Value, After:=WsDD.Range("E680"), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)  '  https://stackoverflow.com/questions/49094391/excel-vba-range-findnext-v-range-find-what-have-i-missed/49181464#49181464
                  Loop ' looping for next match ======
            Else ' no cell value match
            End If
        Else ' case rng has not text in it
        End If
    Next Rng  ' Each Rng In RngDD ---------------|
End Sub

'  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page41#post12677
Sub NewCmdVNewdrivers()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim Wscmd As Worksheet: Set Wscmd = Worksheets("Command17Marz")
Dim Rngcmd As Range ' dont actually need this, since I make a selection.. but I can use it to check the selection
 Set Rngcmd = Wscmd.Range("E4:F260")
    If Intersect(Rngcmd, Selection) Is Nothing Then MsgBox prompt:="oops": Exit Sub
Dim Wsdrs As Worksheet: Set Wsdrs = Worksheets("drivers marz 2020")
Dim Rngdrs As Range
 Set Rngdrs = Wsdrs.Range("D6:E180")
Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
' take each cell in cmd range and find it in DD range
Dim Rng As Range
    For Each Rng In Selection
        If Rng <> "" Then
        Dim FndRng As Range ' range file cell found in DD
        Set FndRng = Rngdrs.Find(what:=Rng.Value, After:=Rngdrs.Cells.Item(1), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndRng Is Nothing Then ' we have a match that may or may not be the only one in DD, I am assuming it is the only one in cmd, at least in the selection I am using
                Wscmd.Activate: Rng.Select
                Let Rng.Font.ColorIndex = ClrIdx
                Application.Wait (Now + TimeValue("00:00:01"))
                   
                    Do While Not FndRng Is Nothing
                    Wsdrs.Activate: FndRng.Select
                    Let FndRng.Font.ColorIndex = ClrIdx
                    Application.Wait (Now + TimeValue("00:00:01"))
                    Set FndRng = Wsdrs.Range("D" & FndRng.Row + 1 & ":E180").Find(what:=Rng.Value, After:=Wsdrs.Range("E180"), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)  '  https://stackoverflow.com/questions/49094391/excel-vba-range-findnext-v-range-find-what-have-i-missed/49181464#49181464
                  Loop ' looping for next match ======
            Else ' no cell value match
            End If
        Else ' case rng has not text in it
        End If
    Next Rng  ' Each Rng In ---- ---------------|
End Sub



'  http://www.excelfox.com/forum/showthread.php/2408-Windows-10-and-Office-Excel/page41#post12678
Sub NewCmdVNewDriverStore()  '    http://www.eileenslounge.com/viewtopic.php?f=55&t=34247#p265646
Dim Wscmd As Worksheet: Set Wscmd = Worksheets("Command17Marz")
Dim Rngcmd As Range ' dont actually need this, since I make a selection.. but I can use it to check the selection
 Set Rngcmd = Wscmd.Range("E4:F260")
    If Intersect(Rngcmd, Selection) Is Nothing Then MsgBox prompt:="oops": Exit Sub
Dim WsDS As Worksheet: Set WsDS = Worksheets("DriverStoreCompareMarz17 2020")
Dim RngDS As Range
 Set RngDS = WsDS.Range("D6:F4395")
Dim ClrIdx As Long: Randomize: Let ClrIdx = (Int(Rnd * 54)) + 3
' take each cell in cmd range and find it in DD range
Dim Rng As Range
    For Each Rng In Selection
        If Rng <> "" Then
        Dim FndRng As Range ' range file cell found in DD
        Set FndRng = RngDS.Find(what:=Rng.Value, After:=RngDS.Cells.Item(1), LookAt:=xlPart, searchorder:=xlNext, MatchCase:=False) '
            If Not FndRng Is Nothing Then ' we have a match that may or may not be the only one in DD, I am assuming it is the only one in cmd, at least in the selection I am using
                Wscmd.Activate: Rng.Select
                Let Rng.Font.ColorIndex = ClrIdx
                Application.Wait (Now + TimeValue("00:00:01"))
                   
                    Do While Not FndRng Is Nothing
                    WsDS.Activate: FndRng.Select
                    Let FndRng.Font.ColorIndex = ClrIdx
                    Application.Wait (Now + TimeValue("00:00:01"))
                    Set FndRng = WsDS.Range("D" & FndRng.Row + 1 & ":F4395").Find(what:=Rng.Value, After:=WsDS.Range("F4395"), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)  '  https://stackoverflow.com/questions/49094391/excel-vba-range-findnext-v-range-find-what-have-i-missed/49181464#49181464
                  Loop ' looping for next match ======
            Else ' no cell value match
            End If
        Else ' case rng has not text in it
        End If
    Next Rng  ' Each Rng In RngDD ---------------|
End Sub


---

http://www.excelfox.com/forum/showth...ll=1#post12897
Test blog

Loop backwards when deleting rows

Important notes in support of these posts: http://www.excelfox.com/forum/showth...ll=1#post12897
https://excelfox.com/forum/showthrea...ire-row-by-vbA
https://excelfox.com/forum/showthrea...wo-excel-files

When deleting rows, ( and when deleting things generally ) , in a Loop, we will usually need to loop backwards.
If we loop backwards, things “behind us” were already considered, and so no strange effects will be noticed if they are effected by further deletions:
If we Loop forwards , rows will shift up after a delete, and so when moving on a row we may miss a row that is needed to be deleted, or other strange effects may occur:
Due to the deletion, things “ahead of us” , which we have not yet considered, may change in some way. The row number or item number, etc., of something not yet considered may change: This can cause VBA to get confused. We may get the wrong results, or worse, cause some coding error:
At the start of a loop, the parameters such as start, stop, and increment are set. Changing these after the loop begins may cause problems. It is generally bad practice to change loop parameters after the loop begins and before the loop ends, especially if those parameters are to be further used before the loop ends.

For example, in the case of deleting things in a looping process, this may sometimes give us problems:

__For Cnt = 1 To 4 Step 1 ' __ 1 2 3 4

Usually, this alternative, would overcome problems:

__For Cnt = 4 To 1 Step -1 ' __ 4 3 2 1

---

Example

We want to delete rows based on value in column C, in the range A1:C4: If the value is Delete this row , then the entire row should be deleted

Before:-

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

Row\Col	A	B	C	D	E	F	G
1	11	a	Do not delete
2	12	B	Delete this row
3	13	c	Delete this row
4	14	D	Do not delete
5
6				Original Range:-
7				11	a	Do not delete
8				12	B	Delete this row
9				13	c	Delete this row
10				14	D	Do not delete
11

Worksheet: MySheet

So in the above example, we want to delete rows 2 and 3.

We could try this macro, but it gives the wrong results. At first glance we would expect it to work.
It loops through the rows, and deletes the row if the value in column C is Delete this row. One could be forgiven for thinking that it should work.

Code:

---

Option Explicit
Sub LoopForwardsToDeleteRows()
Rem 1 Worksheets info
Dim Wb As Workbook, Ws As Worksheet
 Set Wb = ThisWorkbook: Set Ws = Wb.Worksheets.Item(1)

Rem 2 Loop to delete rows
Dim Rws As Long
    For Rws = 1 To 4 '  1 2 3 4
        If Ws.Range("C" & Rws & "").Value = "Delete this row" Then
        Ws.Range("C" & Rws & "").EntireRow.Delete Shift:=xlUp ' Delete entire row, and  Shift  all rows above up to fill space
        Else
        ' Do nothing
        End If
    Next Rws
End Sub

---

After running the above macro we have

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

Row\Col	A	B	C	D	E	F	G
1	11	a	Do not delete
2	13	c	Delete this row
3	14	D	Do not delete
4
5				Original Range:-
6				11	a	Do not delete
7				12	B	Delete this row
8				13	c	Delete this row
9				14	D	Do not delete
10
11

Worksheet: MySheet

This is what goes on:
Nothing is done to the first row. No problems
The second row is deleted as expected, because cell C2 value was Delete this row
After the second row is deleted, the rows which were after the second row, are all shifted one row up so as to fill the space or “hole” left by the removed row. ( We cannot have a “black hole” in an Excel worksheet:. Excel does not allow this. – The spreadsheet cells are moved so as to “fill” the hole made by the deletion. “New” cells are added as necessary at the worksheet perimeter – In this case a new virgin row is added at the bottom of the worksheet )
The result of the second row being deleted, and the necessary shifting of cells to fill the “hole” which is done, is as follows:
Our original 4th row now becomes the 3rd row. That does not cause any problems.
Our original 3rd row now becomes the 2nd row. This is the problem. The second row has already been considered. It will not be considered again. The original 3rd row, ( now, as a result of the first deletion and cell shifting, the second row ) will not be considered. So it remains. It is not considered. It will therefore not be deleted.
When looping forward and deleting, rows not yet considered will be moved: This may cause problems.

The solution to the problem is to loop backwards. When looping backwards, if a row is deleted, then all rows “behind”/ “above” are shifted down. All those rows have already been considered, and either left as they are or deleted.
The next row to be considered, when looping backwards in a worksheet, will always be the next, not yet considered, row, regardless of whether the last row considered was deleted or not: None of the rows not yet considered have been shifted.
When looping backwards and deleting, rows not yet considered will not have been moved

So we try again

Before, ( as in previous example )

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

Row\Col	A	B	C	D	E	F	G
1	11	a	Do not delete
2	12	B	Delete this row
3	13	c	Delete this row
4	14	D	Do not delete
5
6				Original Range:-
7				11	a	Do not delete
8				12	B	Delete this row
9				13	c	Delete this row
10				14	D	Do not delete
11

Worksheet: MySheet

Macro: ( looping backwards )

Code:

---

Sub LoopBackwardsToDeleteRows()
Rem 1 Worksheets info
Dim Wb As Workbook, Ws As Worksheet
 Set Wb = ThisWorkbook: Set Ws = Wb.Worksheets.Item(1)

Rem 2 Loop to delete rows
Dim Rws As Long
    For Rws = 4 To 1 Step -1  '  4 3 2 1
        If Ws.Range("C" & Rws & "").Value = "Delete this row" Then
        Ws.Range("C" & Rws & "").EntireRow.Delete Shift:=xlUp ' Delete entire row, and  Shift  all rows above up to fill space
        Else
        ' Do nothing
        End If
    Next Rws
End Sub

---

After:

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

Row\Col	A	B	C	D	E	F	G
1	11	a	Do not delete
2	14	D	Do not delete
3
4				Original Range:-
5				11	a	Do not delete
6				12	B	Delete this row
7				13	c	Delete this row
8				14	D	Do not delete
9
10
11

Worksheet: MySheet


This time we have the correct results: Looping backwards gives correct results. Looping fowards may give incorrect results.

In support of this Thread
http://www.excelfox.com/forum/showth...the-entire-row

Before

_____ Workbook: sample1.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ACC	EQ	1014	1030	955.5	998.45	957.4
3	NSE	ADANIPORTS	EQ	27.35	27.75	25.65	25.65	25.85
4

Worksheet: Tabelle1

_____ Workbook: sample2.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ACC	EQ	1014	1030	955.5	998.45	957.4
3	NSE	ADANIPORTS	EQ	27.35	28	29	30	27.35
4

Worksheet: Tabelle2


If column H of sample2.xlsx matches with Column D then look column B data of sample2.xlsx and find that data in sample1.xlsx in column B and after getting that data in sample1.xlsx in column B , copy that entire row of sample1.xlsx and paste that in sample2.xlsx in the same row


Result:

_____ Workbook: 2.xlsx ( Using Excel 2007 32 bit )

Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
NSE	ACC	EQ	1014	1030	955.5	998.45	957.4
NSE	ADANIPORTS	EQ	27.35	27.75	25.65	25.65	25.85

Worksheet: Tabelle2

In support of this Post:
http://www.excelfox.com/forum/showth...ll=1#post13014

Before:

_____ Workbook: sample1.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ACC	EQ	1000	1030	955.5	998.45	957.4
3	NSE	ADANIENT	EQ	27.35	27.75	25.65	25.65	25.85
4	NSE	ADANIPORTS	EQ	259	259.6	244	248.2	251.3
5	NSE	ADANIPOWER	EQ	5, 4	5, 5	5, 6	5, 7	5, 8
6	NSE	AMARAJABAT	EQ	459.8	482.25	445.1	439.35	455.35
7	NSE	AMBUJACEM	EQ	7, 4	7, 5	7, 6	7, 7	7, 8
8	NSE	APOLLOHOSP	EQ	8, 4	8, 5	8, 6	8, 7	8, 8
9

Worksheet: anything

_____ Workbook: sample2.xlsx ( Using Excel 2007 32 bit )

Row\Col	A
1	SYMBOL
2	ACC
3	ADANIPORTS
4	AMARAJABAT
5

Worksheet: anything

run macro:

Code:

---

'  http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste/page2#post13014  http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste?p=13014&viewfull=1#post13014
'  http://www.excelfox.com/forum/showthread.php/2445-copy-and-paste-by-vba          http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste?p=13014&viewfull=1#post13014
Sub STEP6d() ' match column B of sample1.xlsx matches with column A of sample2.xlsx
'              if it matches then copy paste the data from column D to column H to sample2.xlsx from column B
Dim Wb1 As Workbook, Wb2 As Workbook                    '          If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
 Set Wb1 = Workbooks("sample1.xlsx")  '                      Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")                ' w1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")          ' change the file path  If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
 Set Wb2 = Workbooks("sample2.xlsx")  '                      Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\FundsCheck.xlsb")      ' w2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\FundsCheck.xlsb") ' change the file path      If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
Dim Ws1 As Worksheet, Ws2 As Worksheet
 Set Ws1 = Wb1.Worksheets("anything")  '    sheet name can be anything
 'Set Ws1 = Wb1.Worksheets.Item(1)
 Set Ws2 = Wb2.Worksheets("anything")
 'Set Ws2 = Wb2.Worksheets.Item(1)
Dim Lr1 As Long, Lr2 As Long  '  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 Lr1 = Ws1.Range("B" & Ws1.Rows.Count).End(xlUp).Row
 Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count).End(xlUp).Row

Dim Cnt As Long
    For Cnt = 2 To Lr2
    Dim FndCel As Range  '  http://www.excelfox.com/forum/showthread.php/2436-conditionally-delete-or-replace-entire-row?p=13007&viewfull=1#post13007
    Dim rngSrch As Range '
    Set rngSrch = Ws1.Range("B2:B" & Lr1 & "")
    Set FndCel = rngSrch.Find(What:=Ws2.Range("A" & Cnt & "").Value, After:=Ws1.Range("B2"), LookIn:=xlValues, LookAt:=xlPart, searchorder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False) '  https://stackoverflow.com/questions/49094391/excel-vba-range-findnext-v-range-find-what-have-i-missed/49181464#49181464
    ' The range to be copied is always offset by 0 rows  and +2 column from the cell found, FndCel,  in column B of sample1.xlsx . Its size will be 1 row and 5 columns
    FndCel.Offset(0, 2).Resize(1, 5).Copy '    copy column D to column H
    ' paste the data from column D to column H to sample2.xlsx from column B
    Ws2.Range("A" & Cnt & "").Offset(0, 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
    Next Cnt
End Sub

---

After Result:-

_____ Workbook: sample2.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G
1	SYMBOL
2	ACC	1000	1030	955.5	998.45	957.4
3	ADANIPORTS	259	259.6	244	248.2	251.3
4	AMARAJABAT	459.8	482.25	445.1	439.35	455.35
5

Worksheet: anything

Macro for this Post
' http://www.excelfox.com/forum/showth...ll=1#post13058 http://www.excelfox.com/forum/showth...3058#post13058

Code:

---

'  http://www.excelfox.com/forum/showthread.php/2421-copy-and-paste-by-VBA-based-on-criteria?p=13058&viewfull=1#post13058    http://www.excelfox.com/forum/showthread.php/2454-copy-and-paste-by-vba?p=13058#post13058
Sub Step10()
Rem 1 Worksheets info
Dim Wb1 As Workbook, Wb2 As Workbook  '                          If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
 Set Wb1 = Workbooks("1.xlsx")        '          Workbooks("sample1.xlsx")  '                                                Set Wb1 = Workbooks.Open(ThisWorkbook.Path & "\1.xls")                ' w1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")          ' change the file path  If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
 Set Wb2 = Workbooks("2.xlsx")        '          Workbooks("sample2.xlsx")  '                                                Set Wb2 = Workbooks.Open(ThisWorkbook.Path & "\FundsCheck.xlsb")      ' w2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\FundsCheck.xlsb") ' change the file path      If the workbook is already open , then we can refer to it using the workbooks collection object of open workbooks,  Workbooks(" ")
Dim Ws1 As Worksheet, Ws2 As Worksheet
 Set Ws1 = Wb1.Worksheets.Item(1)      '                                                                            Set Ws1 = Wb1.Worksheets("anything")  '    sheet name can be anything
 Set Ws2 = Wb2.Worksheets.Item(1)      '                                                                          ' Set Ws2 = Wb2.Worksheets("anything")
Dim Lr1 As Long, Lc1 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 Lc1 = Ws1.Cells.Item(2, Ws1.Columns.Count).End(xlToLeft).Column
Rem 2 Data ranges
Dim arrOut() As String
 ReDim arrOut(1 To Lr1 - 1, 1 To 2) ' A 2 column array of as many rows as data in 1.xlsx  We may not need all the rows
Dim rngIn As Range
 Set rngIn = Ws1.Range(Ws1.Range("A1"), Ws1.Cells.Item(Lr1, Lc1))
Rem 3 Go through rows and columns  in input data range
Dim Rws As Long
    For Rws = 2 To Lr1 ' Go through rows in input data range
    Dim rngInRws As Range
    Set rngInRws = rngIn.Rows.Item(Rws) ' consider a row in the data range
    Dim Clms As Long ' go through columns in each row
        For Clms = 2 To Lc1 ' considering each column in the row under consideration
            If rngInRws.Cells.Item(Clms).Interior.Color = 65535 And rngInRws.Cells.Item(Clms).Value >= 5 Then ' ...if yellow highlighted colour data is greater than 5 or equal to 5 then
            Dim RwOut As Long ' a row in output array
            Let RwOut = RwOut + 1 ' a next new row in output array
            Let arrOut(RwOut, 1) = rngInRws.Cells.Item(1)              ' The value in the first cell in the row under consideration is put in first column in output array
            Let arrOut(RwOut, 2) = rngInRws.Cells.Item(Clms).Value    ' The value in the highlighted cell in the row under consideration is put in the second column of the output array
            Else
            ' Do nothing
            End If
        Next Clms
    Next Rws
Rem 4 Output result
 Let Ws2.Range("A1:B" & Lr1 - 1 & "").Value = arrOut() ' A range of the dimensions of the output array has its values assigned to the values in the output arry
End Sub


---

In support of this question
https://excelribbon.tips.net/T008884..._Into_One.html

Quote:

---

The full syntax of what Allen Wyatt is using is like …….
Cells(Rows.Count, 1).End(xlUp).Item(2) ……..
….
Item(2) will give us the cell just below the cell given by…….
Cells(Rows.Count, 1).End(xlUp) ………

Cells(Rows.Count, 1).End(xlUp) is the same as Cells(Rows.Count, 1).End(xlUp).Item(1) ………
……….
It is not to easy to explain how the items are assigned for a range……
See this demo

---

In the following demo, I show the item numbers for cells in four arbritrary ranges, A9 , B2:C3 , E5:G5 and D10:D12
As you will see, Item numbers are not restricted to just the range itself. The item numbers keep going. They go in a sequence of ... all columns in a row, ... then the next row ... etc....
The column count is determined by the original range, but the rows are not limited.

Row\Col	A	B	C	D	E	F	G
1
2		Item(1)	Item(2)
3		Item(3)	Item(4)
4		Item(5)	Item(6)
5		Item(7)	Item(8)		Item(1)	Item(2)	Item(3)
6		Item(9)	….etc…		Item(4)	Item(5)	Item(6)
7					Item(7)	Item(8)	Item(9)
8					Item(10)	….etc….
9	Item(1)
10	Item(2)			Item(1)
11	Item(3)			Item(2)
12	Item(4)			Item(3)
13	Item(5)			Item(4)
14	Item(6)			Item(5)
15	…..etc….			Item(6)
16				Item(7)
17				Item(8)
18				Item(9)
19				Item(10)
20				….etc…
21

test Evaluate range for this post
http://www.excelfox.com/forum/showth...ecimals-by-vba

We can find the position of the . using Instr function https://docs.microsoft.com/en-us/off...instr-function

Then we can take the left of the number for a length equal to the position of the . + 3 using the Left function https://docs.microsoft.com/en-us/off.../left-function

Then we can remove the . using the Replace function , https://docs.microsoft.com/en-us/off...place-function


or formulas...

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

Row\Col	K	L	M	N
2	1090.699
3	147.965
4	264.4785
5	30.2495
6
7
8		5	1090.69	109069
9		4	147.96	14796
10		4	264.47	26447
11		3	30.24	3024
12
13		1090.699
14		147.965
15		264.4785
16		30.2495

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

Row\Col	K	L	M	N
2	1090.699
3	147.965
4	264.4785
5	30.2495
6
7
8		=FIND(".",K2)	=LEFT(K2,L8+2)	=SUBSTITUTE(M8,".","")
9		=FIND(".",K3)	=LEFT(K3,L9+2)	=SUBSTITUTE(M9,".","")
10		=FIND(".",K4)	=LEFT(K4,L10+2)	=SUBSTITUTE(M10,".","")
11		=FIND(".",K5)	=LEFT(K5,L11+2)	=SUBSTITUTE(M11,".","")
12
13		1090.699
14		147.965
15		264.4785
16		30.2495

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

Row\Col	L	M	N	O
8	=FIND(".",K2)	=LEFT(K2,L8+2)	=SUBSTITUTE(M8,".","")	=SUBSTITUTE(LEFT(K2,FIND(".",K2)+2),".","")
9	=FIND(".",K3)	=LEFT(K3,L9+2)	=SUBSTITUTE(M9,".","")	=SUBSTITUTE(LEFT(K3,FIND(".",K3)+2),".","")
10	=FIND(".",K4)	=LEFT(K4,L10+2)	=SUBSTITUTE(M10,".","")	=SUBSTITUTE(LEFT(K4,FIND(".",K4)+2),".","")
11	=FIND(".",K5)	=LEFT(K5,L11+2)	=SUBSTITUTE(M11,".","")	=SUBSTITUTE(LEFT(K5,FIND(".",K5)+2),".","")

Worksheet: 1-Sheet1

from Forulas, Evaluate Range

Code:

---

Sub EvaluateRangeTrimRemoveDot() '  http://www.excelfox.com/forum/showthread.php/2456-Remove-decimals-by-vba?p=13068#post13068
Dim Ws1 As Worksheet
 Set Ws1 = Workbooks("1.xls").Worksheets.Item(1) ' First worksheet in open workbooks 1.xls
 Dim LrK As Long: Let LrK = Ws1.Range("K" & Ws1.Rows.Count & "").End(xlUp).Row
Dim RngK As Range: Set RngK = Ws1.Range("K2:K" & LrK & "")
 Let RngK.Value = Evaluate("=if({1},SUBSTITUTE(LEFT(" & RngK.Address & ",FIND("".""," & RngK.Address & ")+2),""."",""""))")
End Sub

---

in support of this forum post
http://www.excelfox.com/forum/showth...ll=1#post13088


Explanation 1
In column K are numbers given to a maximum of 2 decimal places, for example
Column K
1090.69
147.95
264.47
30

The value in Column K must be adjusted so that it has the decimal format to 2 decimal places in steps of .05
So in this form, of like
…… 23.95 234 34.25 4.30 100.35 45.45 56.05 ……… etc….

So for example, in the above Column K test data, no adjustment is needed for 147.95 or 30
For 1090.69 and 264.47 some adjustment is needed. The adjustment could be to raise or lower the value. These are the possibilities:
change 1090.69 to 1090.65 or 1090.7
change 264.47 to 264.45 or 264.50

Which of the two adjustments is necessary will depend on the following:
If column H is greater than column D , then we adjust up .
If column H is lower than column D, then we adjust down .

Explanation 2
For all data rows, we compare column H to column D. If column H is greater than column D , then we adjust the value in column K up to the nearest multiple of .05. If column H is less than column D , then we adjust the value in column K down to the nearest multiple of .05. ( If the value in column K is an exact multiple of .05, then no action is to be taken )

For example
Before:

Row\Col	D	E	F	G	H	I	J	K
2	1087	1088	1077.25	1067.25	1079.9	25	10.799	1090.69
3	148.05	149.9	146.5	146	146.5	22	1.465	147.95
4	265	269.3	265	262.85	267.15	15083	2.6715	264.47
5	30.4	30.4	29.8	29.65	29.95	17388	0.2995	30

After:

Row\Col	D	E	F	G	H	I	J	K	L
2	1087	1088	1077.25	1067.25	1079.9	25	10.799	1090.65	This nuber is adjusted down
3	148.05	149.9	146.5	146	146.5	22	1.465	147.95	This number is not changed
4	265	269.3	265	262.85	267.15	15083	2.6715	264.5	This number is adjusted up
5	30.4	30.4	29.8	29.65	29.95	17388	0.2995	30	This number is not changed

---

Solution ( guess )

The previous formula solution already always adjust number down,

Row\Col	D	H	K	L	M	N	O	P
2	1087	1079.9	1090.69	21813.8	21813	1090.65	1090.65	1090.65
3	148.05	146.5	147.95	2959	2959	147.95	147.95	147.95
4	265	267.15	264.47	5289.4	5289	264.45	264.45	264.45
5	30.4	29.95	30	600	600	30	30	30

Row\Col	D	H	K	L	M	N	O	P
2	1087	1079.9	1090.69	=K2*100/5	=INT(L2)	=M2*5/100	=INT(L2)*5/100	=INT(K2*100/5)*5/100
3	148.05	146.5	147.95	=K3*100/5	=INT(L3)	=M3*5/100	=INT(L3)*5/100	=INT(K3*100/5)*5/100
4	265	267.15	264.47	=K4*100/5	=INT(L4)	=M4*5/100	=INT(L4)*5/100	=INT(K4*100/5)*5/100
5	30.4	29.95	30	=K5*100/5	=INT(L5)	=M5*5/100	=INT(L5)*5/100	=INT(K5*100/5)*5/100

So previous solution is correct if H < D
If H > D , the previous solution is .05 too small , so previous solution must be adjusted by +.05

=IF(H2<D2,INT(K2*100/5)*5/100,IF(H2>D2,(INT(K2*100/5)*5/100)+0.05,"H is equal to D"))

=IF(H3<D3,INT(K3*100/5)*5/100,IF(H3>D3,(INT(K3*100/5)*5/100)+0.05,"H is equal to D"))

=IF(H4<D4,INT(K4*100/5)*5/100,IF(H4>D4,(INT(K4*100/5)*5/100)+0.05,"H is equal to D"))

=IF(H5<D5,INT(K5*100/5)*5/100,IF(H5>D5,(INT(K5*100/5)*5/100)+0.05,"H is equal to D"))

But we must also check if number is already exact multiple of .05
Like if ( integer (value/.05)) – value/.05) = 0
( Excel has errors and bugs, and may give a very small number when it should give us 0, so we must do a trick-
if Round ( ( integer (value/.05)) – value/.05) ) = 0 )
So:

=IF(ROUND(INT(K2/0.05)-(K2/0.05),2)=0,K2,IF(H2<D2,INT(K2*100/5)*5/100,IF(H2>D2,(INT(K2*100/5)*5/100)+0.05,"H is equal to D")))

=IF(ROUND(INT(K3/0.05)-(K3/0.05),2)=0,K3,IF(H3<D3,INT(K3*100/5)*5/100,IF(H3>D3,(INT(K3*100/5)*5/100)+0.05,"H is equal to D")))

=IF(ROUND(INT(K4/0.05)-(K4/0.05),2)=0,K4,IF(H4<D4,INT(K4*100/5)*5/100,IF(H4>D4,(INT(K4*100/5)*5/100)+0.05,"H is equal to D")))

=IF(ROUND(INT(K5/0.05)-(K5/0.05),2)=0,K5,IF(H5<D5,INT(K5*100/5)*5/100,IF(H5>D5,(INT(K5*100/5)*5/100)+0.05,"H is equal to D")))

1090.65

147.95

264.5

30

VBA Solution to above, and answer to this Post
http://www.excelfox.com/forum/showth...ll=1#post13102

VBA answer

Put columns in arrays

Row\Col	D
1	Open
2	1087
3	148.05
4	265
5	30.4

arrD() =

1087

148.05

265

30.4

Row\Col	H
1	LTP
2	1079.9
3	146.5
4	267.15
5	29.95

arrH() =

1079.9

146.5

267.15

29.95

Row\Col	K
1
2	1090.69
3	147.95
4	264.47
5	30

arrK() ( initial ) =

1090.69

147.95

264.47

30

The macro below manipulates the contents of arrK() as per the question requirement, then pastes the modified array over the initial values

Code:

---

Sub ChangeSecondNumberAfterDecimalConditionally() ' http://www.excelfox.com/forum/showthread.php/2457-change-the-second-number-after-decimal-conditionally
Rem 1 Worksheets info
Dim Wb1 As Workbook
 Set Wb1 = Workbooks("SAMPLE1 18Apr2020.xlsx")  '  Workbooks("1.xls")        ' CHANGE TO SUIT
Dim Ws1 As Worksheet
 Set Ws1 = Wb1.Worksheets.Item(1)
Dim Lrow As Long
 Let Lrow = 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. )
Rem 2 ranges of interest, D H and K , are placed in 1 column arrays, rows from 2 to Lrow
 Dim arrD() As Variant, arrH() As Variant, ArrK() As Variant  '  The  .Value  property used below returns its values in a field of variant type elements, so to avoiud a type mismatch we must  Dim  here appropriately
 Let arrD() = Ws1.Range("D2:D" & Lrow & "").Value: Let arrH() = Ws1.Range("H2:H" & Lrow & "").Value: Let ArrK() = Ws1.Range("K2:K" & Lrow & "").Value
Rem 3 Manipulate  arrK()  as per requiremnt  For all data rows, we compare column H to column D. If column H is greater than column D , then we adjust the value in column K up to the nearest multiple of .05. If column H is less than column D , then we adjust the value in column K down to the nearest multiple of .05. ( If the value in column K is an exact multiple of .05, then no action is to be taken )  http://www.excelfox.com/forum/showthread.php/2457-change-the-second-number-after-decimal-conditionally?p=13099&viewfull=1#post13099
Dim Cnt
    For Cnt = 1 To Lrow - 1 ' range is row 2 to Lrow-1, array will be 1 to Lrow-1
        If Int(Round((ArrK(Cnt, 1) / 0.05), 2)) - Round((ArrK(Cnt, 1) / 0.05), 2) = 0 Then
        ' do nothing because we have exact mulktiple of .05
        Else ' case K is not an exact multiple of .05
            If arrH(Cnt, 1) < arrD(Cnt, 1) Then
            Let ArrK(Cnt, 1) = Int(ArrK(Cnt, 1) * 100 / 5) * 5 / 100 '    =INT(K2*100/5)*5/100    =K2*100/5    =INT(L2)  =M2*5/100  =INT(L2)*5/100  =INT(K2*100/5)*5/100  http://www.excelfox.com/forum/showthread.php/2457-change-the-second-number-after-decimal-conditionally?p=13100&viewfull=1#post13100
            ElseIf arrH(Cnt, 1) > arrD(Cnt, 1) Then
            Let ArrK(Cnt, 1) = (Int(ArrK(Cnt, 1) * 100 / 5) * 5 / 100) + 0.05
            Else ' case H = D
            Let ArrK(Cnt, 1) = "H is equal to D"
            End If
        End If
    Next Cnt
Rem 4 Paste out modified array over original values
 Let Ws1.Range("K2:K" & Lrow & "").Value = ArrK()
End Sub

---

After running that macro the arrK() contents change to

1090.65

147.95

264.5

30

And that is then pasted out into the range

Row\Col	K
1
2	1090.65
3	147.95
4	264.5
5	30

In support of this Thread
http://www.excelfox.com/forum/showth...d-paste-by-vba

1.xls

Code:

---

A                B                        C                D        E        F        G        H        I        J        K        L
                                                                                                                       
Exchange                Symbol                        Series/Expiry                Open        High        Low        Prev Close        LTP                               
NSE                ACC                        EQ                1182        1193        1151.7        1156.6        1156.6        22        11.566        116815        1168.166
NSE                ADANIENT                        EQ                137.15        140.55        134.1        134.65        134.65        25        1.3465        13595        135.9965
NSE                ADANIPORTS                        EQ                273.95        276.95        269.55        270.65        270.65        15083        2.7065        27335        273.3565
NSE                ADANIPOWER                        EQ                32.3        32.35        30.45        30.65        30.65        17388        0.3065        3095        30.9565
NSE                AMARAJABAT                        EQ                555        555        529.25        532.1        532.1        100        5.321        5374        537.421
NSE                ASIANPAINT                        EQ                1815.05        1842.8        1814        1827.55        1827.55        236        18.2755        18093        1809.2745
NSE                AMBUJACEM                        EQ                169.9        171.6        166.2        167.95        167.95        1270        1.6795        1696        169.6295
NSE                APOLLOHOSP                        EQ                1360        1377.5        1341.1        1359.5        1359.5        157        13.595        137305        1373.095
NSE                APOLLOPIPE                        EQ                277.55        284        277.4        280.15        280.15        14361        2.8015        27735        277.3485
NSE                ASHOKLEY                        EQ                46        46.3        44.6        44.95        44.95        212        0.4495        4535        45.3995
NSE                AUROPHARMA                        EQ                629.05        654.5        618.5        624.45        624.45        275        6.2445        63065        630.6945
NSE                AXISBANK                        EQ                416        419.65        401.25        403.95        403.95        5900        4.0395        40795        407.9895
NSE                BAJAJ-AUTO                        EQ                2410        2472        2381        2445.35        2445.35        16669        24.4535        24209        2420.8965
NSE                BAJAJFINSV                        EQ                4675        4675        4365        4389.8        4389.8        16675        43.898        443365        4433.698
NSE                BAJFINANCE                        EQ                2113.5        2113.5        1970.05        1976.25        1976.25        317        19.7625        199601.25        1996.0125
NSE                BALKRISIND                        EQ                879        887.5        856.7        867.75        867.75        335        8.6775        8764        876.4275
NSE                BANKBARODA                        EQ                47.65        48        46.1        46.35        46.35        4668        0.4635        468        46.8135
NSE                BATAINDIA                        EQ                1258        1313        1230        1239.55        1239.55        371        12.3955        12519        1251.9455
NSE                BEL                        EQ                75.1        77.7        73.35        74.55        74.55        383        0.7455        7525        75.2955
NSE                BERGEPAINT                        EQ                521        535        515        519.7        519.7        404        5.197        52485        524.897
NSE                BHARATFORG                        EQ                251.1        265        251.1        263.25        263.25        422        2.6325        26065        260.6175
NSE                BHARTIARTL                        EQ                494.9        499        484.45        494.25        494.25        10604        4.9425        49915        499.1925
NSE                BHEL                        EQ                21.1        21.4        20.6        20.65        20.65        438        0.2065        2085        20.8565
NSE                BIOCON                        EQ                346        360        339        357.4        357.4        11373        3.574        35385        353.826
NSE                BOSCHLTD                        EQ                10470        10500        10100        10212.45        10212.45        2181        102.1245        1031455        10314.5745
NSE                BPCL                        EQ                352        356.65        347        350.45        350.45        526        3.5045        35395        353.9545
NSE                BRITANNIA                        EQ                2980        3122.9        2956        3062.15        3062.15        547        30.6215        303155        3031.5285
NSE                CADILAHC                        EQ                333.25        344        330.9        336.95        336.95        7929        3.3695        3336        333.5805
NSE                CANBK                        EQ                82.55        84.7        81.05        81.35        81.35        10794        0.8135        8215        82.1635
NSE                CASTROLIND                        EQ                124.15        127        119.3        120.7        120.7        1250        1.207        1219        121.907
NSE                CENTURYTEX                        EQ                289.2        298.5        282        284.05        284.05        625        2.8405        28685        286.8905
NSE                CESC                        EQ                603        609.5        590.95        596.75        596.75        628        5.9675        6027        602.7175
NSE                CHOLAFIN                        EQ                145        145.8        132.05        132.9        132.9        685        1.329        1342        134.229
NSE                CIPLA                        EQ                586.4        606        583.6        599.3        599.3        694        5.993        59335        593.307
NSE                COALINDIA                        EQ                140.6        143.8        135.8        137        137        20374        1.37        13835        138.37
NSE                COLPAL                        EQ                1470        1497.95        1463.6        1483.65        1483.65        15141        14.8365        146885        1468.8135
NSE                CONCOR                        EQ                368        376.6        359.5        361.1        361.1        4749        3.611        3647        364.711
NSE                CUMMINSIND                        EQ                420.95        426.55        377.25        384.95        384.95        1901        3.8495        38875        388.7995
NSE                DABUR                        EQ                499        503.75        494.5        499.05        499.05        772        4.9905        4941        494.0595
NSE                DISHTV                        EQ                5.1        5.15        4.75        4.75        4.75                0.0475        475        4.7975
NSE                DIVISLAB                        EQ                2410        2460        2390.6        2425.4        2425.4        10940        24.254        240115        2401.146
NSE                DLF                        EQ                135        135        127.6        128.2        128.2        14732        1.282        12945        129.482
NSE                DRREDDY                        EQ                4010        4049.6        3970.1        4002.8        4002.8        881        40.028        40428        4042.828
NSE                EICHERMOT                        EQ                14068        14091        13505.1        13589.2        13589.2        910        135.892        1372505        13725.092
NSE                EQUITAS                        EQ                53.85        56.4        50.65        51.05        51.05        16852        0.5105        5155        51.5605
NSE                ESCORTS                        EQ                744        758.7        712.2        717        717        958        7.17        72415        724.17
NSE                EXIDEIND                        EQ                146.3        151.8        145.15        148.45        148.45        676        1.4845        14696.55        146.9655
NSE                FEDERALBNK                        EQ                44        44.2        42.9        43.1        43.1        1023        0.431        435        43.531
NSE                GAIL                        EQ                82.95        84.25        79        81.5        81.5        4717        0.815        823        82.315
NSE                GLENMARK                        EQ                342.7        360.95        342        344.85        344.85        7406        3.4485        34145        341.4015
NSE                GMRINFRA                        EQ                17.5        17.5        17        17.15        17.15        13528        0.1715        173        17.3215
NSE                GODREJCP                        EQ                536.95        547.1        530.05        534.4        534.4        10099        5.344        5397        539.744
NSE                GRASIM                        EQ                492        501.9        484.75        499.05        499.05        1232        4.9905        4941        494.0595
NSE                HAVELLS                        EQ                524        537        517.1        525.6        525.6        9819        5.256        52035        520.344
NSE                HCLTECH                        EQ                480        496.9        465.15        468.1        468.1        7229        4.681        47275        472.781
NSE                HDFC                        EQ                1603        1624.95        1569.1        1580.3        1580.3        1330        15.803        15961        1596.103
NSE                HDFCBANK                        EQ                933        958.4        926        938.05        938.05        1333        9.3805        9287        928.6695
NSE                HEROMOTOCO                        EQ                1842.5        1939.4        1840        1894.8        1894.8        1348        18.948        18759        1875.852
NSE                HINDALCO                        EQ                109.95        109.95        102.85        103.65        103.65        1363        1.0365        10465        104.6865
NSE                HINDPETRO                        EQ                208.75        208.75        200        201.4        201.4        1406        2.014        2034        203.414
NSE                HINDUNILVR                        EQ                2311        2338        2280        2283.1        2283.1        1394        22.831        23059        2305.931
NSE                IBULHSGFIN                        EQ                114        118.4        111        112.95        112.95        30125        1.1295        11405        114.0795
NSE                ICICIBANK                        EQ                337.9        343.25        331.5        334.85        334.85        4963        3.3485        33815        338.1985
NSE                ICICIPRULI                        EQ                348        356.8        329.4        336.55        336.55        18652        3.3655        3399        339.9155
NSE                IDEA                        EQ                4.25        4.25        3.95        4        4        14366        0.04        404        4.04
NSE                IDFCFIRSTB                        EQ                23.35        23.4        22.1        22.2        22.2        11184        0.222        224        22.422
NSE                IGL                        EQ                446        455.7        430        437.25        437.25        11262        4.3725        4416        441.6225
NSE                INDIGO                        EQ                930        938.55        878.75        891.75        891.75        11195        8.9175        90065        900.6675
NSE                INDUSINDBK                        EQ                392.25        399.9        380        382.9        382.9        5258        3.829        3867        386.729
NSE                INFRATEL                        EQ                169        172.9        149.5        152        152        29135        1.52        1535        153.52
NSE                INFY                        EQ                668.55        675        654.8        658        658        1594        6.58        66455        664.58
NSE                IOC                        EQ                82.25        84.4        81.1        81.5        81.5        1624        0.815        823        82.315
NSE                ITC                        EQ                181        182.8        179.3        180.05        180.05        1660        1.8005        18185        181.8505
NSE                JINDALSTEL                        EQ                85        87        78.25        79.15        79.15        6733        0.7915        799        79.9415
NSE                JSWSTEEL                        EQ                157.5        159.5        152.6        153.25        153.25        11723        1.5325        15475        154.7825
NSE                JUBLFOOD                        EQ                1484        1494.7        1444.45        1478.7        1478.7        18096        14.787        149345        1493.487
NSE                JUSTDIAL                        EQ                343        349.85        327        329.8        329.8        29962        3.298        33305        333.098
NSE                KOTAKBANK                        EQ                1219        1258        1213.35        1239.55        1239.55        1922        12.3955        12272        1227.1545
NSE                L&TFH                        EQ                58.5        60.2        58.05        58.95        58.95        24948        0.5895        584        58.3605
NSE                LICHSGFIN                        EQ                280        281        259.15        260.65        260.65        1997        2.6065        26325        263.2565
NSE                LT                        EQ                838        869        834.15        851.2        851.2        11483        8.512        8427        842.688
NSE                LUPIN                        EQ                824.7        891        820.7        877.35        877.35        10440        8.7735        8686        868.5765
NSE                M&M                        EQ                342        344.75        332        334.3        334.3        2031        3.343        3376        337.643
NSE                M&MFIN                        EQ                150        150        138.2        140.45        140.45        13285        1.4045        14185        141.8545
NSE                MANAPPURAM                        EQ                106        108.1        104.05        107.1        107.1        19061        1.071        10605        106.029
NSE                MARICO                        EQ                300.9        309.55        300        306.1        306.1        4067        3.061        30305        303.039
NSE                MARUTI                        EQ                5100        5140        5030        5045.65        5045.65        10999        50.4565        50961        5096.1065
NSE                MCDOWELL-N                        EQ                524.9        527.9        516.7        519.5        519.5        10447        5.195        52465        524.695
NSE                MFSL                        EQ                415        432.75        400.55        420.15        420.15        2142        4.2015        41595        415.9485
NSE                MGL                        EQ                912        936.95        890        913.05        913.05        17534        9.1305        90395        903.9195
NSE                MINDTREE                        EQ                770.75        785        755        780.35        780.35        14356        7.8035        77255        772.5465
NSE                MOTHERSUMI                        EQ                72.4        74.25        71.35        72        72        4204        0.72        727        72.72
NSE                MRF                        EQ                58225        59200        58000        58805.4        58805.4        2277        588.054        5821735        58217.346
NSE                MUTHOOTFIN                        EQ                809.4        834        798.05        813.95        813.95        23650        8.1395        80585        805.8105
NSE                NATIONALUM                        EQ                33.75        34.9        30.55        31.5        31.5        6364        0.315        318        31.815
NSE                NBCC                        EQ                20.5        20.6        18.9        19.25        19.25        31415        0.1925        194        19.4425
NSE                NCC                        EQ                25.45        25.8        24.4        24.6        24.6        2319        0.246        248        24.846
NSE                NESTLEIND                        EQ                17300        17800        17300        17406.05        17406.05        17963        174.0605        1723198.95        17231.9895
NSE                NIITTECH                        EQ                1181        1199        1085.25        1116.1        1116.1        11543        11.161        112725        1127.261
NSE                NMDC                        EQ                76.7        77.9        73.4        73.8        73.8        15332        0.738        745        74.538
NSE                NTPC                        EQ                94.75        96.35        91.95        93.4        93.4        11630        0.934        943        94.334
NSE                OIL                        EQ                86        88.6        83.5        83.85        83.85        17438        0.8385        8465        84.6885
NSE                ONGC                        EQ                67.15        69.5        66.6        67.6        67.6        2475        0.676        6695        66.924
NSE                PAGEIND                        EQ                17550        17970        17460        17854.35        17854.35        14413        178.5435        1767585        17675.8065
NSE                PEL                        EQ                815        877.45        808.1        864.45        864.45        2412        8.6445        85585        855.8055
NSE                PETRONET                        EQ                220        222.95        215.75        218.5        218.5        11351        2.185        22065        220.685
NSE                PFC                        EQ                90.7        94.35        89.6        91.05        91.05        14299        0.9105        9015        90.1395
NSE                PIDILITIND                        EQ                1532.1        1576.8        1500.15        1505.2        1505.2        2664        15.052        152025        1520.252
NSE                PNB                        EQ                30.7        31.1        30.15        30.2        30.2        10666        0.302        305        30.502
NSE                POWERGRID                        EQ                157        160.1        155.75        159.15        159.15        14977        1.5915        1576        157.5585
NSE                PVR                        EQ                973        989.4        950        954.6        954.6        13147        9.546        9641        964.146
NSE                RAMCOCEM                        EQ                569.5        584.4        534        538.05        538.05        2043        5.3805        5434        543.4305
NSE                RBLBANK                        EQ                104.5        110.7        101.7        107.15        107.15        18391        1.0715        1061        106.0785
NSE                RECLTD                        EQ                90.65        93.4        89.1        89.35        89.35        15355        0.8935        902        90.2435
NSE                RELIANCE                        EQ                1350.15        1494.95        1347.2        1417        1417        2885        14.17        140285        1402.83
NSE                SAIL                        EQ                26        27.35        25.8        26.9        26.9        2963        0.269        2665        26.631
NSE                SBIN                        EQ                184        184        179        179.75        179.75        3045        1.7975        1815        181.5475
NSE                SHREECEM                        EQ                18739        18927.3        18382.55        18587.45        18587.45        3103        185.8745        187733        18773.3245
NSE                SIEMENS                        EQ                1159        1203.7        1135        1145.9        1145.9        3150        11.459        115735        1157.359
NSE                SRF                        EQ                3602        3660.8        3470        3488.05        3488.05        3273        34.8805        35229        3522.9305
NSE                SRTRANSFIN                        EQ                610        699        579.25        668.2        668.2        4306        6.682        66155        661.518
NSE                SUNPHARMA                        EQ                476.95        497        473.55        485.55        485.55        3351        4.8555        4807        480.6945
NSE                SUNTV                        EQ                368.7        385.45        366.5        376.9        376.9        13404        3.769        37315        373.131
NSE                TATACHEM                        EQ                263.4        273        255.35        270.05        270.05        3405        2.7005        26735        267.3495
NSE                TATAMOTORS                        EQ                75        76.9        74        74.2        74.2        3456        0.742        749        74.942
NSE                TATAMTRDVR                        EQ                34.3        34.95        33.5        33.7        33.7        16965        0.337        3403.7        34.037
NSE                TATAPOWER                        EQ                32.6        32.6        30.8        31.05        31.05        3426        0.3105        3135        31.3605
NSE                TATASTEEL                        EQ                266.3        273.85        264.45        267.55        267.55        3499        2.6755        2649        264.8745
NSE                TCS                        EQ                1840.7        1851.95        1807.8        1818.55        1818.55        11536        18.1855        18367        1836.7355
NSE                TECHM                        EQ                522        532.6        502.1        503.45        503.45        13538        5.0345        50845        508.4845
NSE                TITAN                        EQ                910        926.9        893.1        906.05        906.05        3506        9.0605        9151        915.1105
NSE                TORNTPHARM                        EQ                2430        2488        2361.65        2430.5        2430.5        3518        24.305        24062        2406.195
NSE                TORNTPOWER                        EQ                297.5        307.9        296.65        303.8        303.8        13786        3.038        3008        300.762
NSE                TVSMOTOR                        EQ                298        302        289.05        297        297        8479        2.97        29995        299.97
NSE                UBL                        EQ                921        922.5        863.85        880.75        880.75        16713        8.8075        88955        889.5575
NSE                UJJIVAN                        EQ                170        173.5        161.6        164.1        164.1        17069        1.641        1657        165.741
NSE                ULTRACEMCO                        EQ                3410        3440        3292.8        3307.95        3307.95        11532        33.0795        334102.95        3341.0295
NSE                UPL                        EQ                345        347.6        334.2        335.85        335.85        11287        3.3585        3392        339.2085
NSE                VEDL                        EQ                76.8        80.25        75.7        77.95        77.95        3063        0.7795        772        77.1705
NSE                VOLTAS                        EQ                500        505        485        487.15        487.15        3718        4.8715        49202.15        492.0215
NSE                WIPRO                        EQ                179.95        180.8        177.15        177.75        177.75        3787        1.7775        1795        179.5275
NSE                ZEEL                        EQ                150.8        152.85        143        145.15        145.15        3812        1.4515        1466        146.6015

---

Shortened
http://www.excelfox.com/forum/showth...ll=1#post13126
_____ Workbook: 1 26Apr.xls ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G	H	I	J	K	L
1	Exchange	Symbol	Series/Expiry	Open	High	Low	Prev Close	LTP
2	NSE	ACC	EQ	1182	1193	1151.7	1156.6	1156.6	22	11.566	116815	1168.166
3	NSE	ADANIENT	EQ	137.15	140.55	134.1	134.65	134.65	25	1.3465	13595	135.9965
4	NSE	ADANIPORTS	EQ	273.95	276.95	269.55	270.65	270.65	15083	2.7065	27335	273.3565
5	NSE	ADANIPOWER	EQ	32.3	32.35	30.45	30.65	30.65	17388	0.3065	3095	30.9565
6	NSE	AMARAJABAT	EQ	555	575	529.25	532.1	570.1	100	5.321	5374	537.421

Worksheet: 1-Sheet1

From last post
Before
_____ Workbook: Alert.txt ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G
1	NSE	14361	6			A
2	NSE	25	6			A
3	NSE	15083	6			A
4	NSE	17388	6			A
5	NSE	100	6			A
6	NSE	22	6			A
7

Worksheet: Alert

Quote:

---

check wheather column H of 1.xls is greater or lower than column D of 1.xls

if column H of 1.xls is greater than column D of 1.xls then match column I of 1.xls with column B of 2.csv & if it matches then put this symbol "<" in column D of 2.csv & copy paste the data of column K of 1.xls in column E of 2.csv

or

if column H of 1.xls is lower than column D of 1.xls then match column I of 1.xls with column B of 2.csv & if it matches then put this symbol ">" in column D of 2.csv & copy paste the data of column K of 1.xls in column E of 2.csv

---

Run macro ( from here https://www.ozgrid.com/forum/index.p...54#post1233954 )

Code:

---

Sub STEP8() '  http://www.excelfox.com/forum/showthread.php/2461-copy-and-paste-by-vba?p=13126&viewfull=1#post13126
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim rg1 As Range, i As Long, c As Range
Set Wb1 = Workbooks("1.xls")      '  Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks("Alert.txt")  '  Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert..csv")
Set Ws1 = Wb1.Worksheets.Item(1)
Set Ws2 = Wb2.Worksheets.Item(1)
Set rg1 = Ws1.Cells(1, 1).CurrentRegion
    With rg1
        For i = 2 To rg1.Rows.Count
            If .Cells(i, 8) > .Cells(i, 4) Then    ' if column H of 1.xls is greater than column D of 1.xls
            Set c = Ws2.Columns(2).Find(.Cells(i, 9)) ' match column I of 1.xls with column B of 2.csv
                If Not c Is Nothing Then 'if match found
                c.Offset(, 2).Value = "<"          '  put this symbol "<" in column D of 2
                c.Offset(, 3).Value = .Cells(i, 11) '  copy paste the data of column K of 1.xls in column E of 2.csv
                End If
            Else  '    if column H of 1.xls is lower than column D of 1.xls
            Set c = Ws2.Columns(2).Find(.Cells(i, 9)) '  match column I of 1.xls with column B of 2.csv
                If Not c Is Nothing Then 'if match found
                c.Offset(, 2).Value = ">"            '  then put this symbol ">" in column D of 2.csv
                c.Offset(, 3).Value = .Cells(i, 11)  '  copy paste the data of column K of 1.xls in column E of 2.csv
                End If
            End If
        Next i
    End With
End Sub

---

After - results after running macro above

_____ Workbook: Alert.txt ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G
1	NSE	14361	6			A
2	NSE	25	6	>	13595	A
3	NSE	15083	6	>	27335	A
4	NSE	17388	6	>	3095	A
5	NSE	100	6	<	5374	A
6	NSE	22	6	>	116815	A
7

Worksheet: Alert

---

1.xls : https://app.box.com/s/38aoip5xi7018y9syt0xe4g04u95l6xk
macro.xlsm : https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt
Alert.csv : https://app.box.com/s/4ejptbaggn67nc91yz9jhgcefm2qae0r

In support of this post
http://www.excelfox.com/forum/showth...ll=1#post13131
It is not necessary to have all data to demonstrate the problem!!

Quote:

---

Originally Posted by DocAElstein

....It is difficult in a forum to work with many rows.
Reduce the rows
We need just enough data to test.
Pick your test data carefully.
Just use a few rows. But pick your test data carefully so that it test all scenarios....

---

Quote:

---

Originally Posted by DocAElstein

....make a small file with also row data that errors.
Explain again and show me what and where the errors are….

---

_____ 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	DABUR	EQ	499	503.75	494.5	499	499.05	772	4.9905	4941	494.0595
4	NSE	DISHTV	EQ	5.1	5.15	4.75	4.95	4.75		0.0475	475	4.7975
5	NSE	UBL	EQ	921	922.5	863.85	920	880.75	16713	8.8075	88955	889.5575
6	NSE	UJJIVAN	EQ	170	173.5	161.6	179.55	164.1	17069	1.641	1657	165.741
7	NSE	VEDL	EQ	76.8	80.25	75.7	77.6	77.95	3063	0.7795	772	77.1705
8	NSE	VOLTAS	EQ	500	505	485	508.2	487.15	3718	4.8715	49202.15	492.0215
9	NSE	ZEEL	EQ	150.8	152.85	143	157.55	145.15	3812	1.4515	1466	146.6015
10
11
12

Worksheet: 1-Sheet1 27Apr_2


Before

_____ Workbook: Alert.csv ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F	G
1	NSE	25	6			A
2	NSE	3812	6			A
3	NSE	15083	6			A
4	NSE	22	6			A
5

Worksheet: Alert.

Run macro, then we have After results:

_____ Workbook: Alert.csv ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F
1	NSE	25	6			A
2	NSE	3812	6	>	1466	A
3	NSE	15083	6			A
4	NSE	22	6	>	116815	A
5				>	475

Worksheet: Alert.

---

match column I of 1.xls with column B of 2.csv

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

Row\Col	F	G	H	I	J
1	Low	Prev Close	LTP
2	1151.7	1190.45	1156.6	22	11.566
3	494.5	499	499.05	772	4.9905
4	4.75	4.95	4.75		0.0475
5	863.85	920	880.75	16713	8.8075
6	161.6	179.55	164.1	17069	1.641

_____ Workbook: Alert.csv ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D
3	NSE	15083	6
4	NSE	22	6
5
6

match column I of 1.xls with column B of 2.csv
column I of 1.xls is Empty
column B of 2.csv is Empty
Empty = Empty = Match



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

Row\Col	F	G	H	I	J
1	Low	Prev Close	LTP
2	1151.7	1190.45	1156.6	22	11.566
3	494.5	499	499.05	772	4.9905
4	4.75	4.95	4.75	Empty	0.0475
5	863.85	920	880.75	16713	8.8075
6	161.6	179.55	164.1	17069	1.641

_____ Workbook: Alert.csv ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D
3	NSE	15083	6
4	NSE	22	6
5		Empty
6

In support of this post
http://www.excelfox.com/forum/showth...ll=1#post13140

Explanation of the problem
The error is caused by bad understanding of Range.Find Method ( https://docs.microsoft.com/de-de/off...cel.range.find )

We only need small amount of test data to demonstrate the problem:
Consider the results of this test data

Before:

_____ 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

Worksheet: 1-Sheet1 27Apr_2 (2)

_____ Workbook: AlertTestData.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F
1	NSE	25	6			A
2	NSE	17388	6			A
3	NSE	404	6			A
4	NSE	422	6			A
5	NSE	10604	6			A
6	NSE	438	6			A
7	NSE	10794	6			A
8	NSE	1250	6			A
9	NSE	625	6			A
10	NSE	15083	6			A
11	NSE	22	6			A
12

Worksheet: Alert.


results After
_____ Workbook: AlertTestData.xlsx ( Using Excel 2007 32 bit )

Row\Col	A	B	C	D	E	F
1	NSE	25	6			A
2	NSE	17388	6			A
3	NSE	404	6			A
4	NSE	422	6	>	116815	A
5	NSE	10604	6			A
6	NSE	438	6			A
7	NSE	10794	6			A
8	NSE	1250	6	>	13595	A
9	NSE	625	6			A
10	NSE	15083	6	>	27335	A
11	NSE	22	6			A
12

Worksheet: Alert.


Those results come from using this macro here: http://www.excelfox.com/forum/showth...ll=1#post13143
Those results arise due to this problem code line
Ws2.Columns(2).Find(.Cells(i, 9))

That code line is only using one argument for Range.Find Method
So VBA must guess the others. It has guessed not what we want. It has guessed similar to this
Ws2.Columns(2).Find(What:=.Cells(i, 9), After:=B1, LookAt:xlpart)

Because of After:=B1 , it starts to look from B2 in
Because of LookAt:xlpart , we will look for what we want anywhere inside a cell, so if we are looking for the number 25 , then all these numbers or even text could be a match
4567256
2500
25
564rghsseeffzz25adksfhaejh
VBA will choose the first match that it finds

For example, for our 25 it started looking from B2 in Worksheet Alert, and the first it found was 1250

---

For large data, there will be many errors caused by this problem. But the problem and the solution will be the same.
It is easier to demonstrate the problem with small test data.
It is easier to test a solution with small test data.

It is the responsibility of the person finally responsible for the macros in real use to take the time to check for larger amounts of real data. For getting free help in a forum , this will be the responsibility of the persom getting help.

---

Share ‘1.xls’ : https://app.box.com/s/38aoip5xi7018y9syt0xe4g04u95l6xk
Share ‘AlertTestData.xlsx’ : https://app.box.com/s/nhdxcq0ulxldebanz1lz49wr1stf1pc4
Share ‘macro.xlsm’ : https://app.box.com/s/599q2it3uck3hfwm5kscmmgtn0be66wt

Macro used to get the results in the last post above

In support of this post
http://www.excelfox.com/forum/showth...ll=1#post13140
Previous macro
https://www.ozgrid.com/forum/index.p...38#post1234138

Code:

---

'  Old macro (  https://www.ozgrid.com/forum/index.php?thread/1227284-copy-and-paste-by-macro/&postID=1234138#post1234138  )
Sub STEP8() '  http://www.excelfox.com/forum/showthread.php/2461-copy-and-paste-by-vba?p=13126&viewfull=1#post13126
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Dim rg1 As Range, i As Long, c As Range
Set Wb1 = Workbooks("1.xls")      '  Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks("AlertTestData.xlsx")  '  Workbooks("Alert.csv") ' Workbooks("Alert.txt")  '  Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert..csv")
Set Ws1 = Wb1.Worksheets.Item(1)
Set Ws2 = Wb2.Worksheets.Item(1)
Set rg1 = Ws1.Cells(1, 1).CurrentRegion
   
    With rg1
        For i = 2 To rg1.Rows.Count
            If .Cells(i, 8) > .Cells(i, 4) Then    ' if column H of 1.xls is greater than column D of 1.xls
                If .Cells(i, 9).Value = "" Then
                ' do nothing
                Else
                Set c = Ws2.Columns(2).Find(.Cells(i, 9)) ' match column I of 1.xls with column B of 2.csv
                    If Not c Is Nothing Then 'if match found
                    c.Offset(, 2).Value = "<"          '  put this symbol "<" in column D of 2
                    c.Offset(, 3).Value = .Cells(i, 11) '  copy paste the data of column K of 1.xls in column E of 2.csv
                    End If
                End If
            Else  '    if column H of 1.xls is lower than column D of 1.xls
                If .Cells(i, 9).Value = "" Then
                ' do nothing
                Else
                Set c = Ws2.Columns(2).Find(.Cells(i, 9)) '  match column I of 1.xls with column B of 2.csv
                    If Not c Is Nothing Then 'if match found
                    c.Offset(, 2).Value = ">"            '  then put this symbol ">" in column D of 2.csv
                    c.Offset(, 3).Value = .Cells(i, 11)  '  copy paste the data of column K of 1.xls in column E of 2.csv
                    End If
                End If
            End If
        Next i
    End With
End Sub

---

New macro ( for http://www.excelfox.com/forum/showth...3144#post13144 )

Code:

---

Sub STEP8_AE() '  http://www.excelfox.com/forum/showthread.php/2461-copy-and-paste-by-vba?p=13126&viewfull=1#post13126
Rem 1 Worksheets data range info
Dim Wb1 As Workbook, Wb2 As Workbook
Dim Ws1 As Worksheet, Ws2 As Worksheet
Set Wb1 = Workbooks("1.xls")                  '  Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xls")
Set Wb2 = Workbooks("AlertTestData.xlsx")    '  Workbooks("Alert.csv") ' Workbooks("Alert.txt")  '  Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\Alert..csv")
Set Ws1 = Wb1.Worksheets.Item(1)
Set Ws2 = Wb2.Worksheets.Item(1)
Dim Rg1 As Range, RngSrchIn As Range
 Set Rg1 = Ws1.Cells.Item(1, 1).CurrentRegion
Dim Lr2 As Long: Let Lr2 = Ws2.Range("B" & 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. )
 Set RngSrchIn = Ws2.Range("B1:B" & Lr2 & "") ' Only us as much of Column B as we need to search in for a match
Rem 2
Dim Cnt
    For Cnt = 2 To Rg1.Rows.Count            ' For all rows in  1.xls
    Dim cRng As Range '2a Check for match, BUT DO IT PROPERLY!!! -    http://www.excelfox.com/forum/showthread.php/2345-Appendix-Thread-(-Codes-for-other-Threads-HTML-Tables-etc-)?p=13142&viewfull=1#post13142
    Set cRng = RngSrchIn.Find(What:=Ws1.Cells.Item(Cnt, 9), LookIn:=xlValues, Lookat:=xlWhole, searchorder:=xlByRows, Searchdirection:=xlNext, MatchCase:=True)
        If Not cRng Is Nothing And Not cRng.Value = "" Then
            If Ws1.Cells(Cnt, 8) > Ws1.Cells(Cnt, 4) Then      ' if column H of 1.xls is greater than column D of 1.xls
            Let cRng.Offset(, 2).Value = "<"                  '  put this symbol "<" in column D of 2
            Let cRng.Offset(, 3).Value = Ws1.Cells(Cnt, 11)    '  copy paste the data of column K of 1.xls in column E of 2.csv
            ElseIf Ws1.Cells(Cnt, 8) < Ws1.Cells(Cnt, 4) Then  ' if column H of 1.xls is lower than column D of 1.xls
            Let cRng.Offset(, 2).Value = ">"                  '  then put this symbol ">" in column D of 2.csv
            Let cRng.Offset(, 3).Value = Ws1.Cells(Cnt, 11)        '  copy paste the data of column K of 1.xls in column E of 2.csv
            Else
            ' column H of 1.xls is equal to column D of 1.xls
            End If
        Else  ' cRng is nothing so no match was found, or cell was empty
        ' do nothing
        End If
    Next Cnt

End Sub




'        If .Cells(i, 8) > .Cells(i, 4) Then  ' if column H of 1.xls is greater than column D of 1.xls
'            If .Cells(i, 9).Value = "" Then
'            ' do nothing
'            Else
'            Set c = Ws2.Columns(2).Find(.Cells(i, 9)) ' match column I of 1.xls with column B of 2.csv
'                If Not c Is Nothing Then 'if match found
'                c.Offset(, 2).Value = "<"          '  put this symbol "<" in column D of 2
'                c.Offset(, 3).Value = .Cells(i, 11) '  copy paste the data of column K of 1.xls in column E of 2.csv
'                End If
'            End If
'        Else  '    if column H of 1.xls is lower than column D of 1.xls
'            If .Cells(i, 9).Value = "" Then
'            ' do nothing
'            Else
'            Set c = Ws2.Columns(2).Find(.Cells(i, 9)) '  match column I of 1.xls with column B of 2.csv
'                If Not c Is Nothing Then 'if match found
'                c.Offset(, 2).Value = ">"            '  then put this symbol ">" in column D of 2.csv
'                c.Offset(, 3).Value = .Cells(i, 11)  '  copy paste the data of column K of 1.xls in column E of 2.csv
'                End If
'            End If
'        End If

---

Macro for this Post
http://www.excelfox.com/forum/showth...ed-from-Sheet1

Code:

---

Option Explicit
Sub testIt() ' http://www.excelfox.com/forum/showthread.php/2463-VBA-to-create-formula-references-and-values-in-Sheet2-that-either-reference-or-are-derived-from-Sheet1
 Call Worksheet_SelectionChange(Me.Range("B10"))
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Rem 1 check fo column B single cell selection, if not exit sub
    If Target.Cells.Count > 1 Or Application.Intersect(Target, Columns("B")) Is Nothing Then Exit Sub
Rem 2 second worksheets info
Dim Ws2 As Worksheet: Set Ws2 = ThisWorkbook.Worksheets.Item(2)
Dim Lr2 As Long: Let Lr2 = Ws2.Range("A" & Ws2.Rows.Count & "").End(xlUp).Row
Rem 3 insert row -  create a new row on "Sheet2" one line above the last used row and fill in the cells as follows:
 Ws2.Rows("" & Lr2 & ":" & Lr2 & "").Insert shift:=xlDown
Rem 4 Create formulas in columns "A" ("Description") & "B" ("Item #") in "Sheet2" that have formulas that references those values from "Sheet1".
Dim Ws1 As Worksheet: Set Ws1 = ThisWorkbook.Worksheets.Item(1)
 Let Ws2.Range("A" & Lr2 & "").Value = "=" & Ws1.Name & "!" & Target.Address(Rowabsolute:=False, columnabsolute:=False)
 Let Ws2.Range("B" & Lr2 & "").Value = "=" & Ws1.Name & "!" & Target.Offset(0, 1).Address(Rowabsolute:=False, columnabsolute:=False)
Rem 5 create a formula in column "E" ("Gross Income") in "Sheet2".
 Let Ws2.Range("E" & Lr2 & "").Value = "=" & Ws2.Range("C" & Lr2 & "").Address(Rowabsolute:=False, columnabsolute:=False) & "*" & Ws2.Range("D" & Lr2 & "").Address(Rowabsolute:=False, columnabsolute:=False)
Rem 6 fill in a value in column "G" ("Sugg. Retail Price") in "Sheet2" from the value in column "F" ("Sugg. Retail Price") of "Sheet1"
 Let Ws2.Range("G" & Lr2 & "").Value = Ws1.Range("D" & Target.Row & "").Value
End Sub

---

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

Worksheet: 1-Sheet1 3Mai

_____ 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

Worksheet: Sheet1


_..........
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

Worksheet: 2