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

**Excel Fox** · 03-07-2020, 11:49 AM

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

**fixer** · 03-07-2020, 02:50 PM

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

**DocAElstein** · 03-07-2020, 10:01 PM

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.

**fixer** · 03-07-2020, 10:28 PM

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

**fixer** · 03-10-2020, 12:14 PM

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

**DocAElstein** · 03-10-2020, 01:28 PM

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

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

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

Thread Tools

Search Thread

Display

vba code has issue

Similar Threads

VBA referring to external shared Libraries, 1) Early, 1.5) Laterly Early and 2) Late Binding Techniques

Removed highlighted colour based on condition Leonardo1234 rider@1234

VBA Range.Sort with arrays. Alternative for simple use.

Class Stuff: VBA Custom Classes & Objects, Class Modules

Free And Simple Excel Based Gantt Chart

Tags for this Thread

Bookmarks

Bookmarks

Posting Permissions