EDIT….Boss threw me a curveball;
i’d like to pull out values for several ranges of data in excel. The ranges are defined by date.
sDate variable aDate result
1/2/2012 totalN 1/3/2012 9
1/2/2012 Nitrate 1/4/2012 ND
1/8/2012 totalN 1/10/2012 7.2
1/9/2012 EC 1/10/2012 8
1/9/2012 totalN 1/12/2012 8.4
1/9/2012 Nitrate 1/12/2012 ND
so, for the above, I’d like to pull variable, aDate & result of each unique sDate-variable combination. I have a set output .xls that would need to be populated, in the following format:
date TriCHL aDate DiCHL aDate totalN aDate Nitrate aDate BEN aDate EC aDate
1/2/2012 - - - - 9 1/3/2012 ND 1/4/2012 - - - -
1/8/2012 - - - - 7.2 1/10/2012 - - - - - -
1/9/2012 - - - - 8.4 1/12/2012 ND 1/12/2012 - - 8 1/10/2012
VBA would be OK, filling an array with unique values, then looping over the array and selecting from the entire range, then extracting values??
I’m lost
thanks for any help!
Edit
Here’s my solution; may not be elegant, but it’s functional
Sub ProcessData()
Dim sRng As Range 'starting position of SAMPDATE colrow of input data from lab ***static***
Dim endsRng As Range 'end SAMPDATE colrow of input data from lab
Dim Rng As Range 'total range of SAMPDATE colrow of input data from lab
Dim row As Object 'row object for input data iteration
Dim sDate As Range 'starting colrow of unique sample dates on output sheet ***static***
Dim endsDate As Range 'end colrow of unique sample dates on output sheet
Dim totalrng As Range 'total range of unique sample dates on output sheet
Dim datad As String 'sample date on output sheet
Dim datav As String 'chemical variable name on output sheet
Dim i, j As Integer 'used for iterating the output matrix
Dim finalr As String 'final result values from the input lab data
Dim finald As String 'final anadate values from the input lab data
'lets get the last row of the input data
Sheets("data").Select
Set sRng = Sheets("data").Range("f2")
sRng.Select
Do
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Value)
Set endsRng = ActiveCell.Offset(-1, 0)
'lets set the total range of the input data as Rng
Set Rng = Sheets("data").Range(sRng.Address & ":" & endsRng.Address)
For Each row In Rng.Rows
'this is an attempt at being flexible
If row.Offset(0, 2).Value Like "*1,1-Dichloroethene*" Then
row.Offset(0, 2).Value = "1,1-Dichloroethylene"
ElseIf row.Offset(0, 2).Value Like "*cis-1,2-Dichloroethene*" Then
row.Offset(0, 2).Value = "cis-1,2-Dichloroethylene"
ElseIf row.Offset(0, 2).Value Like "*Methylene chloride*" Then
row.Offset(0, 2).Value = "Dichloromethane"
ElseIf row.Offset(0, 2).Value Like "*Cyanide*" Then
row.Offset(0, 2).Value = "Free Cyanide"
ElseIf row.Offset(0, 2).Value Like "*Chlorobenzene*" Then
row.Offset(0, 2).Value = "Monochlorobenzene"
ElseIf row.Offset(0, 2).Value Like "*1,4-Dichlorobenzene*" Then
row.Offset(0, 2).Value = "para-Dichlorobenzene"
ElseIf row.Offset(0, 2).Value Like "*Tetrachloroethene*" Then
row.Offset(0, 2).Value = "Tetrachloroethylene"
ElseIf row.Offset(0, 2).Value Like "*Antimony*" Then
row.Offset(0, 2).Value = "Total Antimony"
ElseIf row.Offset(0, 2).Value Like "*Fluoride*" Then
row.Offset(0, 2).Value = "Total Fluoride"
ElseIf row.Offset(0, 2).Value Like "*Arsenic*" Then
row.Offset(0, 2).Value = "Total Arsenic"
ElseIf row.Offset(0, 2).Value Like "*Barium*" Then
row.Offset(0, 2).Value = "Total Barium"
ElseIf row.Offset(0, 2).Value Like "*Beryllium*" Then
row.Offset(0, 2).Value = "Total Beryllium"
ElseIf row.Offset(0, 2).Value Like "*Cadmium*" Then
row.Offset(0, 2).Value = "Total Cadmium"
ElseIf row.Offset(0, 2).Value Like "*Chromium*" Then
row.Offset(0, 2).Value = "Total Chromium"
ElseIf row.Offset(0, 2).Value Like "*Lead*" Then
row.Offset(0, 2).Value = "Total Lead (as Pb)"
ElseIf row.Offset(0, 2).Value Like "*Nickel*" Then
row.Offset(0, 2).Value = "Total Nickel"
ElseIf row.Offset(0, 2).Value Like "*Selenium*" Then
row.Offset(0, 2).Value = "Total Selenium (Se)"
ElseIf row.Offset(0, 2).Value Like "*Thallium*" Then
row.Offset(0, 2).Value = "Total Thallium"
ElseIf row.Offset(0, 2).Value Like "*Mercury*" Then
row.Offset(0, 2).Value = "Total Mercury as Hg"
ElseIf row.Offset(0, 2).Value Like "*Nitrogen, Total*" Then
row.Offset(0, 2).Value = "Total Nitrogen"
ElseIf row.Offset(0, 2).Value Like "*Xylenes, Total*" Then
row.Offset(0, 2).Value = "Total Xylenes"
ElseIf row.Offset(0, 2).Value Like "*trans-1,2-Dichloroethene*" Then
row.Offset(0, 2).Value = "trans-1,2-Dichloroethylene"
ElseIf row.Offset(0, 2).Value Like "*Trichloroethene*" Then
row.Offset(0, 2).Value = "Trichloroethylene"
ElseIf row.Offset(0, 2).Value Like "*TTHMs*" Then
row.Offset(0, 2).Value = "Trihalomethanes (TTHM)"
ElseIf row.Offset(0, 2).Value Like "*Vinyl chloride*" Then
row.Offset(0, 2).Value = "Vinyl Chloride"
ElseIf row.Offset(0, 2).Value Like "*Total Coliform*" Then
row.Offset(0, 2).Value = "Total Coliform"
ElseIf row.Offset(0, 2).Value Like "*1,2-Dichlorobenzene*" Then
row.Offset(0, 2).Value = "o-Dichlorobenzene"
ElseIf row.Offset(0, 2).Value Like "*E*Coli" Then
row.Offset(0, 2).Value = "Fecal Coliform"
End If
Next row
'lets get the last row of the unique sample dates on the output sheet
Sheets("output").Select
Set sData = Sheets("output").Range("b2")
sData.Select
Do
ActiveCell.Offset(1, 0).Select
Loop Until IsEmpty(ActiveCell.Value)
Set endsDate = ActiveCell.Offset(-1, 0)
'lets set the total range of the unique sample dates on the output sheet
Set totalrng = Range(sData.Address & ":" & endsDate.Address)
For i = 2 To (totalrng.Count + 1)
For j = 3 To 77
datad = Cells(i, 2).Value
datav = Cells(1, j).Value
For Each row In Rng.Rows
If (row.Value = datad And row.Offset(0, 2).Value = datav) Then
finalr = row.Offset(0, 3).Value
finald = row.Offset(0, 1).Value
Exit For
End If
Next row
If (finalr = "--" And finald = "--") Then
Cells(i, j).Value = ""
Cells(i, j + 1).Value = ""
Else
Cells(i, j).Value = finalr
Cells(i, j + 1).Value = finald
End If
'lets clear the variables for the next iteration
finalr = "--"
finald = "--"
'here we skip the analyze date col
j = j + 1
Next j
Next i
End Sub
There is no need for VBA or a formula 🙂 You can use the Pivot Table. See the snapshot below.
HTH
Sid