edit the row data by highlighted cells

i need the vba code to edit the data in a row  by highlighted cells
plz look into the attachment all details are given
Sample123.xlsm
Avinash SinghAsked:
Who is Participating?
 
Neil FlemingConnect With a Mentor Independent consultantCommented:
I think the attached does what you want.

Here's the code attached to the button in the file uploaded
Option Explicit

Sub GetData()
Dim wSource As Worksheet, wTarg As Worksheet
Dim rSource As Range, rTarg As Range, rCell As Range
Dim iStart As Long, i As Long, iLast As Long
Dim highlight As Boolean, gap As Boolean

Set wSource = ActiveSheet
Set wTarg = ActiveWorkbook.Worksheets.Add

'create source range
Set rSource = wSource.Cells(1, 1).CurrentRegion
Set rSource = rSource.Resize(1, rSource.Columns.Count - 1).Offset(1, 0)
'target range:
Set rTarg = wTarg.Cells(1, 1)
Do
    gap = False
    highlight = False
    'start at second cell in each row
    iStart = 2
    For i = 2 To rSource.Columns.Count
    'stop at blank cell:
    If rSource(i) = "" Then Exit For
        If rSource(i).Interior.Color <> RGB(255, 255, 255) Then
            If highlight Then
            'do nothing if cell is next to highlighted cell
            Else
            highlight = True
            'mark second highlighted cell
            If gap Then iStart = i
            End If
        Else
        If highlight Then gap = True
        highlight = False
        End If
    Next
'don't use iStart as first column if no data after it
iLast = i - 1
If iLast = iStart Then iStart = 2

'insert row title
rTarg = rSource(1)
Set rTarg = rTarg.Offset(0, 1)

'copy found data
For i = iStart To iLast
rTarg = rSource(i)
rTarg.Interior.Color = rSource(i).Interior.Color
Set rTarg = rTarg.Offset(0, 1)
Next

'next source row
Set rSource = rSource.Offset(1, 0)
'next target row
Set rTarg = rTarg.Offset(1, 1 + (rTarg.Column * -1))
'stop at first blank row
Loop Until rSource(1) = ""

End Sub

Open in new window

Sample123.xlsm
1
 
Avinash SinghAuthor Commented:
Awesome sir thnx sir for giving ur precious time to this post  u r the best of best
1
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
@Avinash

You are supposed to accept the answer given by Neil Fleming to mark your question as Solved.
1
Get your problem seen by more experts

Be seen. Boost your question’s priority for more expert views and faster solutions

 
Neil FlemingIndependent consultantCommented:
Many thanks Neeraj, for spotting that. I'm sure it was just a slip of the mouse.
0
 
Subodh Tiwari (Neeraj)Excel & VBA ExpertCommented:
You're welcome Neil! I guessed the same.
0
 
Avinash SinghAuthor Commented:
best solution by Neil Fleming sir
1
Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.

All Courses

From novice to tech pro — start learning today.