loop through column to find value

[gaba]

I think that I have the right logic but the code is still not working.

The idea is when I double click on a cell (Column A) it changes color (8).
I'll like from there to loop through the columns (same row) to find which
cells are colored (8) and copy the value(s) on the same sheet (E50).

So each time the user double clicks a row in column A it would find the
corresponding values and copy them down.

any help/ideas more than appreciated....
Gaba

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
'on double click change color to show selection
'go through columns and find desired (blue colored) values, copy them
starting E50

Dim myCell As Range
Dim LastRow As Long
Dim LastCol As Long
Dim iRow As Long
Dim iCol As Long
Dim oRow As Long
Dim myColorIndex As Long
Dim element As Long

element = Range("F6").Value 'cell stores number of total elements

myColorIndex = 8
oRow = 0
With ActiveSheet
With .UsedRange
LastCol = .Columns(.Columns.Count).Column
End With
End With

If Not IsEmpty(Target) Then
ActiveCell.Select
With Target.Interior
If .ColorIndex = xlNone Then
.ColorIndex = 8
For iCol = 1 To LastCol '2 to lastcol
If .ActiveCell.Font.ColorIndex = myColorIndex Then
ActiveSheet.Cells(50, "E").Value _
= .Cells(iRow, iCol).Value
End If
Next iCol
Else
.ColorIndex = xlNone
End If

End With
Cancel = True

End If

End Sub

 

[Myrna Larson]

Several comments:

You have defined many variables that you never use. I think I've deleted most
of them. What's the relevance of the value in F6? What is oRow to be used for?
And LastRow? What about MyCell?

You talk about double-clicking on a cell in column A. You never check that
Target is in column A. Do you want this routine to run regardless of the cell
that you click, even E50?

You are inside a "With Target.Interior" block. Then you write
.ActiveCell

That means "Target.Interior.ActiveCell", which is nonsense. Cell interiors
don't contain cells.

You write ActiveCell.Select. Since this is a double-click event, and you can't
double-click on more than one cell at a time, the selected cell is the active
cell is Target. This line serves no purpose.

You go through the "For i" loop, always checking the color of the active cell
(i.e. the color of Target). You never change the active cell inside the loop.
If the color of the active cell is what you want, then you should get it once,
before you start the loop.

Is the definition of a "colored cell" one with an interior color or a colored
font? Your code checks the color of the FONT, not the color of the interior.

I suspect that what you intend is to check the interior color of each cell as
you move across the row on which you double-clicked. See below.

I don't see any place where you've assigned a value to iRow. Therefore this
line
ActiveSheet.Cells(50, "E").Value = .Cells(iRow, iCol).Value
will cause an error -- there's no row 0.

Where are the copied values to be placed?

As it stands, you keep copying the value from (presumably) Target's row to
cell E50. Each value overwrites the previous one.

Let's assume E50 is empty.

Do you want to copy the first value to E50, the next to E51, the next to E52,
etc?

Or do you want the 1st value in E50, the next in F50, then G50, etc?

Or do they go to row 50 in the same column from which they came? And on the
next double-click would they go to row 51?

You have more End If statements than you have If's

It's very confusing to start a With block after an If block, then write the
End With statement AFTER the End If.

Here is a "cleaned up" version, but it doesn't make sense WRT where you are
copying the values.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
'on double click change color to show selection
'go through columns and find desired (blue colored) values,
'copy them starting E50

Dim LastCol As Long
Dim iRow As Long
Dim iCol As Long
Dim myColorIndex As Long

If Not IsEmpty(Target) Then
myColorIndex = 8
With ActiveSheet.UsedRange
LastCol = .Columns(.Columns.Count).Column
End With

iRow = Target.Row '<<<<< IS THIS CORRECT?
With ActiveSheet
For iCol = 1 To LastCol
'I ASSUME YOU WANT TO CHECK THE COLOR OF THE CELL in column iCol
'DO YOU WANT TO CHECK THE FONT COLOR OR THE INTERIOR COLOR?
'If .Cells(iRow, iCol).Font.ColorIndex = myColorIndex Then
If .Cells(iRow, iCol).Interior.ColorIndex = myColorIndex Then
'THE NEXT LINE MAKES NO SENSE AS WRITTEN -- YOU ARE
'CONTINUALLY OVERWRITING THE VALUE IN E50
'WHERE ARE THE VALUES TO BE COPIED -- SEE COMMENTS ABOVE
.Cells(50, "E").Value = .Cells(iRow, iCol).Value
End If
Next iCol
With Target.Interior
If .ColorIndex = xlNone Then .ColorIndex = myColorIndex
End With
End With
Else
Target.Interior.ColorIndex = xlNone
End If

Cancel = True

End If

End Sub

 

[gaba]

Thanks Myrna for your step by step explanations. Now I see all the silly
things I've done. I had the double click working and I was trying to add more
code in. I'll be more careful next time.

-F6 Contains the total number of rows to go through. Since I import a
different text file every time, I count the rows of elements to work with
once and keep it in F6.

-You are right, I'm looking to check the interior color

-I'm looking to click the cell in column A and look through the columns for
the values that belong to that name:

Sodium Na 23 20 < 20 < 20 1106.281 5498.761 < 20
Phosphorus P 31 20 < 20 20.000 1000.002 1024.760 < 20
Calcium Ca 44 50 < 50 < 50 1099.982 5487.047 < 50
Chromium Cr 52 5 < 5 < 5 99.999 501.866 < 5
Cobalt Co 59 5 < 5 < 5 99.999 501.700 < 5
Germanium Ge 72 5 < 5 < 5

Of course the interior color is not showing, but say I double click "Sodium"
it would go through the row and find <20 colored, 5498.761 colored. Get this
two values and put in order in E50, F50,etc.
The rows in column A have white espaces in between (they are hiden).

I'll go through your code, read it really careful and then put it up

Thanks
Gaba

 

[Myrna Larson]

-F6 Contains the total number of rows to go through. Since I import a
different text file every time, I count the rows of elements to work with
once and keep it in F6.

Why? You don't use the row count in the code.

Since you want this to be a double-click routine, what the code does should be
related to the cell on which you clicked and other cells that have some
logical relationship to that cell (in your case, the relationship is that they
are in the same row).

If you want a macro that processes all rows, IMO it shouldn't be a
double-click event macro -- you would be putting code there that is unrelated
to WHERE you double-clicked.

-I'm looking to click the cell in column A and look through the columns for
the values that belong to that name:

Then you at the top of the procedure you should have some code like

Of course the interior color is not showing, but say I double click "Sodium"
it would go through the row and find <20 colored, 5498.761 colored. Get this
two values and put in order in E50, F50,etc.

Presumably you are going to double-click on the sheet more than once. And I
presume you would not want to over-write date you've already copied to row 50,
but put it in row 51.

You need code to find the last filled cell in column E, and save that in a
variable. You also need to keep track of what column you just copied to, so
you don't over-write E50, but put the next value in F50.

I'm surprised you don't also want to copy an information that identifies which
row and column the data came from, but then I don't understand your ultimate
purpose ...

Anyway, see if this does what you want.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, _
Cancel As Boolean)
'on double click change color to show selection
'go through columns and find desired (blue colored) values,
'copy them starting at first empty cell at or below E50

Dim DestCol As Long
Dim DestRow As Long
Dim iRow As Long
Dim iCol As Long
Dim LastCol As Long
Dim myColorIndex As Long

With Target
'must click in column A, between rows 2 and 49
If .Column <> 1 Or .Row < 2 Or .Row > 49 Then Exit Sub
End With

If Not IsEmpty(Target) Then
myColorIndex = 8

With Target.Parent 'parent of a range is the worksheet

'determine where to put the copied values: find the
'last filled cell in column E and move down one row
DestCol = .Columns("E").Column
DestRow = .Cells(.Rows.Count, DestCol).End(xlUp).Row + 1
If DestRow < 50 Then DestRow = 50
DestCol = DestCol - 1 'back up one column for now

iRow = Target.Row
With .UsedRange
LastCol = .Columns(.Columns.Count).Column
End With

For iCol = 1 To LastCol
If .Cells(iRow, iCol).Interior.ColorIndex = myColorIndex Then
DestCol = DestCol + 1
.Cells(DestRow, DestCol).Value = .Cells(iRow, iCol).Value
End If
Next iCol

Target.Interior.ColorIndex = myColorIndex

End With
Else
Target.Interior.ColorIndex = xlNone
End If

Cancel = True

End Sub

 

[gaba]

Myrna,
Thanks a lot. It took me a little while but I got it working the way I
wanted. Thanks to your explanations and patience!

Gaba