G
gaba
Hi there. I have this piece of code working but still not doing what I need to.
I have column A with certain values highlighted blue. Once I find the color
cell, I go thru the columns for that row looking for all the blue colored
cells. Then I'll copy the value to another column (E) and add some
information. So far so good...
Sub Select_Results()
Dim te As Long 'total elements
Dim LastEl As Long 'Last Element Row
Dim lastC As String 'Last column letter
Dim i As Long
Dim oRng As Range
Dim DestCol As Long 'Destination column
Dim DestRow As Long 'Destination row
Dim oCol As Long 'zero column
myfilename = Range("H3").Value
Sheets("Results " & myfilename & " data").Select
te = Range("F6").Value
LastEl = (te + 15)
lastC = Range("I100").Value
DestCol = Columns("E").Column
oCol = Columns("E").Column
DestRow = LastEl + 6
oRow = LastEl + 6
With Worksheets("Results " & myfilename & " data").Range("B16").Select
For i = 1 To LastEl
On Error Resume Next
Set oRng = Cells.Find(What:=ActiveCell.Offset(0, 0).Value, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows)
If Not oRng Is Nothing Then
If ActiveCell.Offset(0, -1).Interior.ColorIndex = 8 Then
Cells(DestRow, DestCol).Value = ActiveCell.Offset(0, -1).Value
For Each c In Range(ActiveCell.Offset(0, 3).Address, lastC &
i + 15)
If c.Interior.ColorIndex = 8 Then
'ActiveSheet.Paste Link:=True
Cells(DestRow, DestCol + 1).Value = c.Value
Cells(DestRow, DestCol + 2).Value = "mg/L"
Cells(DestRow, DestCol + 3).Value = "1"
Cells(DestRow, DestCol + 5).Value = "EPA 200.8"
Cells(DestRow, DestCol + 6).Value = "Date"
DestCol = DestCol + 8
End If
Next
If DestRow <> "" Then
DestRow = DestRow + 1
Else
DestRow = DestRow
End If
End If
End If
DestCol = oCol
ActiveCell.Offset(1, 0).Select
Next i
End With
Range("H2").Select
End Sub
Here is the challenge:
Once I find the c.values, I need to Paste link those values to the new
locations (column e +1, +8, etc) , set the interior color index to 8, and
format the numbers to 3 significant digits
I need to repeat the first value found (column A) for each c.value found: if
there is a second value for Germanium, I start in DesCol + 8
the resuls look like this
From Col A: c.value:
Germanium < 5 mg/L 1 EPA 200.8 Date
Lead 499.91361 mg/L 1 EPA 200.8 Date
mg/L, 1, EPA 200.8 and date I need to find this information matching the
values from column A (Germanium, Lead) in another sheet (3).
Is all this possible? Any help I would really really appreciate. Oh Boy is
going to be a long night....
Thanks,
I have column A with certain values highlighted blue. Once I find the color
cell, I go thru the columns for that row looking for all the blue colored
cells. Then I'll copy the value to another column (E) and add some
information. So far so good...
Sub Select_Results()
Dim te As Long 'total elements
Dim LastEl As Long 'Last Element Row
Dim lastC As String 'Last column letter
Dim i As Long
Dim oRng As Range
Dim DestCol As Long 'Destination column
Dim DestRow As Long 'Destination row
Dim oCol As Long 'zero column
myfilename = Range("H3").Value
Sheets("Results " & myfilename & " data").Select
te = Range("F6").Value
LastEl = (te + 15)
lastC = Range("I100").Value
DestCol = Columns("E").Column
oCol = Columns("E").Column
DestRow = LastEl + 6
oRow = LastEl + 6
With Worksheets("Results " & myfilename & " data").Range("B16").Select
For i = 1 To LastEl
On Error Resume Next
Set oRng = Cells.Find(What:=ActiveCell.Offset(0, 0).Value, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows)
If Not oRng Is Nothing Then
If ActiveCell.Offset(0, -1).Interior.ColorIndex = 8 Then
Cells(DestRow, DestCol).Value = ActiveCell.Offset(0, -1).Value
For Each c In Range(ActiveCell.Offset(0, 3).Address, lastC &
i + 15)
If c.Interior.ColorIndex = 8 Then
'ActiveSheet.Paste Link:=True
Cells(DestRow, DestCol + 1).Value = c.Value
Cells(DestRow, DestCol + 2).Value = "mg/L"
Cells(DestRow, DestCol + 3).Value = "1"
Cells(DestRow, DestCol + 5).Value = "EPA 200.8"
Cells(DestRow, DestCol + 6).Value = "Date"
DestCol = DestCol + 8
End If
Next
If DestRow <> "" Then
DestRow = DestRow + 1
Else
DestRow = DestRow
End If
End If
End If
DestCol = oCol
ActiveCell.Offset(1, 0).Select
Next i
End With
Range("H2").Select
End Sub
Here is the challenge:
Once I find the c.values, I need to Paste link those values to the new
locations (column e +1, +8, etc) , set the interior color index to 8, and
format the numbers to 3 significant digits
I need to repeat the first value found (column A) for each c.value found: if
there is a second value for Germanium, I start in DesCol + 8
the resuls look like this
From Col A: c.value:
Germanium < 5 mg/L 1 EPA 200.8 Date
Lead 499.91361 mg/L 1 EPA 200.8 Date
mg/L, 1, EPA 200.8 and date I need to find this information matching the
values from column A (Germanium, Lead) in another sheet (3).
Is all this possible? Any help I would really really appreciate. Oh Boy is
going to be a long night....
Thanks,