Misc. Leonardo1234 rider@1234 vixer. Highlighting. Simple Early stuff. Avinash Introduction

Try this

Code:

---

Sub GetNSEData()

    Dim varFilteredSource() As Variant
    Dim rngSourceRange As Range
    Dim lngRow As Long, lngCol As Long
   
    Set rngSourceRange = Workbooks("1.xlsx").Worksheets("Sheet1").Cells(1).CurrentRegion
    lngRow = rngSourceRange.Rows.Count
    ReDim varFilteredSource(1 To lngRow, 1 To 2)
   
    For lngRow = 2 To lngRow
        varFilteredSource(lngRow, 1) = rngSourceRange.Cells(lngRow, 1).Value
        varFilteredSource(lngRow, 2) = rngSourceRange.Cells(lngRow, 2).Value
        For lngCol = 2 To rngSourceRange.Columns.Count - 1
            If rngSourceRange.Cells(lngRow, lngCol).Interior.ColorIndex <> -4142 Then
                varFilteredSource(lngRow, 2) = rngSourceRange.Cells(lngRow, lngCol + 1).Value
                Exit For
            End If
        Next lngCol
    Next lngRow
   
    With Workbooks("2.xlsx").Worksheets("Sheet1")
        .Range("M1").Resize(lngRow - 1, 2).Value = varFilteredSource
        .Range("L2").Formula = "=IFERROR(VLOOKUP(B2,$M$2:$N$" & lngRow - 1 & ",2,0),"""")"
        .Range("L2").AutoFill Destination:=.Range("L2:L" & .Cells(Rows.Count, 1).End(xlUp).Row)
        With .Range("L2:L" & .Cells(Rows.Count, 1).End(xlUp).Row)
            .Value = .Value
        End With
        .Range("M1").Resize(lngRow - 1, lngCol - 1).ClearContents
    End With
    Erase varFilteredSource
    Set rngSourceRange = Nothing
   
End Sub

---

https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgzMCQUIQgrbec400jl4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwhVTFaD469mW9wO194AaABAg. 9gJzxwFcnPU9gORqKw5tW_
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugyb8nmKKoXvcdM58gV4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgwvvXcl1oa79xS7BAV4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=UgxvIFArksPprylHXYZ4AaABAg
https://www.youtube.com/watch?v=f7xZivqLZxc&lc=Ugxq4JHRza_zx3sz0fx4AaABAg
https://www.youtube.com/channel/UCnxwq2aGJRbjOo_MO54oaHA

Code:

---

Sub STEP13()

    Dim varFilteredSource() As Variant
    Dim rngSourceRange As Range
    Dim lngRow As Long, lngCol As Long
    Set w1 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\1.xlsx")
    Set w2 = Workbooks.Open("C:\Users\WolfieeeStyle\Desktop\2.xlsb")
   
    Set rngSourceRange = w1.Worksheets("Sheet1").Cells(1).CurrentRegion
    lngRow = rngSourceRange.Rows.Count
    ReDim varFilteredSource(1 To lngRow, 1 To 2)
   
    For lngRow = 2 To lngRow
        varFilteredSource(lngRow, 1) = rngSourceRange.Cells(lngRow, 1).Value
        varFilteredSource(lngRow, 2) = rngSourceRange.Cells(lngRow, 2).Value
        For lngCol = 2 To rngSourceRange.Columns.Count - 1
            If rngSourceRange.Cells(lngRow, lngCol).Interior.ColorIndex <> -4142 Then
                varFilteredSource(lngRow, 2) = rngSourceRange.Cells(lngRow, lngCol + 1).Value
                Exit For
            End If
        Next lngCol
    Next lngRow
   
    With w2.Worksheets("Sheet1")
        .Range("M1").Resize(lngRow - 1, 2).Value = varFilteredSource
        .Range("L2").Formula = "=IFERROR(VLOOKUP(B2,$M$2:$N$" & lngRow - 1 & ",2,0),"""")"
        .Range("L2").AutoFill Destination:=.Range("L2:L" & .Cells(Rows.Count, 1).End(xlUp).Row)
        With .Range("L2:L" & .Cells(Rows.Count, 1).End(xlUp).Row)
            .Value = .Value
        End With
        .Range("M1").Resize(lngRow - 1, lngCol - 1).ClearContents
    End With
    Erase varFilteredSource
    Set rngSourceRange = Nothing
    w1.Save
    w2.Save
    w1.Close
    w2.Close
End Sub

---

I putted this code plz have allok and if any mistake is there from my end plz let me know excel fox
Thnx Alot ExcelFox in helping me in solving this problem thnx alot Doc Sir for the help

Hi,


…”..one mistake happened from my end in providing the info to u , we have to copy and paste the data after highlighted colours cells…..
This is easy to change: we can copy one cell to the right , .Offset(0, 1)
Change

Code:

---

        Rng.Offset(0, 1).Resize(, Ws1.UsedRange.Columns.Count - 1).SpecialCells(xlCellTypeFormulas, xlNumbers + xlTextValues).Copy

---

to

Code:

---

        Rng.Offset(0, 1).Resize(, Ws1.UsedRange.Columns.Count - 1).SpecialCells(xlCellTypeFormulas, xlNumbers + xlTextValues).Offset(0, 1).Copy

---

……. If there are no highlighted colour cells in the row then copy paste the first cells of that row …..”….

In my macro, I added a “=“ to the highlighted cells : see http://www.excelfox.com/forum/showth...ll=1#post12570

So we can do another If Else to look for a “=” in the row.
It seems that we can use the Range.Find Method to find any formula if What we look for is
=
So we can use that method to search the row for a first match. If Nothing is returned, then we have no highlighted cell
Like this

Code:

---

    Dim HigChk As Range
    Set HigChk = Rng.Offset(0, 1).Resize(, Ws1.UsedRange.Columns.Count - 1).Find(What:="=", LookIn:=xlFormulas, LookAt:=xlPart)
        If Not HigChk Is Nothing Then ' we found a highlighted cell -----------
        ' copy the yellow highlighted colured cell data in that row of 1.xlsx
        Rng.Offset(0, 1).Resize(, Ws1.UsedRange.Columns.Count - 1).SpecialCells(xlCellTypeFormulas, xlNumbers + xlTextValues).Offset(0, 1).Copy
        ' paste it to column L OF 2.xlsx
        Else ' case no highlighted cell, so column B should be copüied from 1.xlsx
        Rng.Offset(0, 1).Copy
        End If                        ' we were looking for highligted cell ---

---

All info and files here: http://www.excelfox.com/forum/showth...ll=1#post12580


Alan

---

P.S. I did also try macro from ExcelFox. This also seems to give the same results as my macro on your test data.

thnx alot Doc sor for providing the info
I can never ever doubt on some of the vba programmers code bcoz there are very few programmer's i seen who doesnt need a sample file for the hardest vba code and u r one of them sir Ur code was perfect it was mine mistake i provided the incorrect info

kindly see the sample file.....

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

Row\Col	P	Q	R	S
12
13
14
15			abc
16			def
17
18
19			when I ran the code
20			this data is deleted why sir
21			plz have a look sir and help me in solving this problem sir
22
23

Worksheet: Sheet1

Large column count is being .Cleared Contents of is
LngColumnTooLong.JPG : https://imgur.com/SujMF73
Attachment 2789

So..
Try is maybe only want 2 columns to be .Cleared Contents of is

So change

Code:

---

        .Range("M1").Resize(lngRow - 1, lngCol - 1).ClearContents

---

to

Code:

---

        .Range("M1").Resize(lngRow - 1, 2).ClearContents

---