Value find help

[cmm0812]

I have a spreadsheet in which I need to pull the monthly numbers for certain products. The product names that I will need the values for each month are "Apple," "Melons," "Tomatoes," and "Onion."

I have attached a sample document. The "0" values listed will change to actuals each month.

Can anyone help me with this? I am currently using the statement: "If Range("E5").Value > 0 Then" in my macro to pull "Apple" values for April, but it doesn't return any results, so I am missing something.

Thanks!

[rbrhodes]

Hi where are you pulling the values to? Perhaps post your code?

[Bob Phillips]

What do you mean by 'pull up'?

Where is the code?

Give an example worked through.

[david000]

I think you need a 2-way lookup, and you can get better ones than mine from here if that's what you need. So, take a look and rephrase your question if need be...

[cmm0812]

I want to move the values from Sheet1 to Sheet2.

The macro is in the sample doc attached.

[Bob Phillips]

Could you just use

=SUMPRODUCT((Sheet1!$A$3:$A$20=A3)*(Sheet1!$B$3:$M$20))

in B3 and copy down.

[rbrhodes]

Hi cm,


I presume you are running the macro while viewing sheet2 to see the results. Won't work.

The Code says if Range("B3")>0 and of course it's never > 0 because it's looking in B3 of sheet 2. If you were viewing Sheet 1 when you ran the code Sheet2 would end up with results of "Apples", Melons" etc as the column # in your lookup tables are off by - 1. (That's a subsiduary problem)

So what I did is a little tutorial (ensconsed <sp?> in the code in the form of comments) to show you how to build the references to the sheets you want. This way you can run the macro from any sheet and it knows where to look.

I also added 1 to all the column numbers in the lookups so they will work correctly.

Et cetera.

Have a look!

[vba]
'Always a good idea! In VBE click 'Tools' menu, Options
' and on the Editor Tab check 'Require variable declaration'
' Will save you lots of time with misspelled variable names
' see further explanation below
Option Explicit
Sub Sort()
'//Note: Always use at least One caPitol letter in your
' variable names. Then type in non Caps and VBE will
' change the variable to the caPitol letter you used in
' the Dim statement. This, combined with 'Option Explict',
' will catch speelling misteaks in your code
'
' For example: Variable for last row of date could be
'
' Dim lastRow as long
'
' then when you type lastrow (no caps)the VBE will change it to
'
' lastRow
'
'
'Now the code:
'Create a variable for source sheet
Dim Ws1 As Worksheet
'Create a variable for destination sheet
Dim Ws2 As Worksheet
'Create references using the variables
Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")

'Turn off screen refresh for speed
' and to avoid 'flicker' effect
Application.ScreenUpdating = False

'Once your code is running satisfactorily,
' uncomment the next line to handle any
' unexpected run time errors

'On Error Goto endo


'Use a 'With' to avoid retyping the sheet name
' This also speed up the code...
With Ws2
.Range("A3").Value = "Apples"
.Range("A4").Value = "Melons"
.Range("A5").Value = "Tomatoes"
.Range("A6").Value = "Onions"
.Range("A7").Value = "Total"
.Range("B7").Value = "=SUM(B3:B5)"
.Columns("A:A").EntireColumn.AutoFit
.Range("A2").Font.Bold = True
.Range("A2:B2").MergeCells = True
.Range("A2:B2").HorizontalAlignment = xlCenter
'//Not sure about this bit. You're only checking the
' value of row 3 to determine whether to do anything.
' If the first column has a value in row three the rest
' of the sub will NEVER run...?
If Ws1.Range("B3").Value > 0 Then


'//Here I changed ALL the values in your lookup to lookup column + 1
' so they will return the correct values from the lookup table
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:B, 2, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:B, 2, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:B, 2, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:B, 2, 0)"
.Range("A2").Value = "January 2008 Orders"
ElseIf Ws1.Range("C3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:C, 3, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:C, 3, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:C, 3, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:C, 3, 0)"
.Range("A2").Value = "February 2008 Orders"
ElseIf Ws1.Range("D3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A, 4, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A, 4, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A, 4, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A, 4, 0)"
.Range("A2").Value = "March 2008 Orders"
ElseIf Ws1.Range("E3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:E, 5, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:E, 5, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:E, 5, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:E, 5, 0)"
.Range("A2").Value = "April 2008 Orders"
ElseIf Ws1.Range("F3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:F, 6, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:F, 6, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:F, 6, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:F, 6, 0)"
.Range("A2").Value = "May 2008 Orders"
ElseIf Ws1.Range("G3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:G, 7, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:G, 7, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:G, 7, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:G, 7, 0)"
.Range("A2").Value = "June 2008 Orders"
ElseIf Ws1.Range("H3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:H, 8, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:H, 8, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:H, 8, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:H, 8, 0)"
.Range("A2").Value = "July 2008 Orders"
ElseIf Ws1.Range("I3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:I, 9, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:I, 9, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:I, 9, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:I, 9, 0)"
.Range("A2").Value = "August 2008 Orders"
ElseIf Ws1.Range("J3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:J, 10, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:J, 10, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:J, 10, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:J, 10, 0)"
.Range("A2").Value = "September 2008 Orders"
ElseIf Ws1.Range("K3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:K, 11, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:K, 11, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:K, 11, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:K, 11, 0)"
.Range("A2").Value = "October 2008 Orders"
ElseIf Ws1.Range("L3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:L, 12, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:L, 12, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:L, 12, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:L, 12, 0)"
.Range("A2").Value = "November 2008 Orders"
ElseIf Ws1.Range("M3").Value > 0 Then
.Range("B3").Value = "=VLOOKUP(A3, Sheet1!A:M, 13, 0)"
.Range("B4").Value = "=VLOOKUP(A4, Sheet1!A:M, 13, 0)"
.Range("B5").Value = "=VLOOKUP(A5, Sheet1!A:M, 13, 0)"
.Range("B6").Value = "=VLOOKUP(A6, Sheet1!A:M, 13, 0)"
.Range("A2").Value = "December 2008 Orders"
Else
MsgBox ("Orders cannot be calculated")
End If
'//Close the 'With'
End With

'Delete the references
Set Ws1 = Nothing
Set Ws2 = Nothing

'Reset the screen refresh
Application.ScreenUpdating = True

'Normal exit
Exit Sub


'Errored out
endo:
'Reset the screen refresh
Application.ScreenUpdating = True

'Inform the user
MsgBox ("Error! " & Err.Number & " " & Err.Description)

End Sub

[/vba]

[cmm0812]

That works wonderfully, thanks dr! I mistakenly miscalculated the column #'s; they were right in my actual document but wrong in the sample. I also changed first line of the IF statement to read as follows: "Ws1.Range("B3").Value > 0 And Ws1.Range("C3") = 0 Then" and just changed all other following IfThen statements accordingly.

Now, just one other question. For some months, I may have two strings named "Apple" located in col A. Is there a way to find the corresponding values in the Sheet1 table for both of those strings, add the two values together, and show that as the total sum for all "Apples" in cell A3 in Sheet2?

[rbrhodes]

Hi cmm.

Well yes there are many! However since you're using the sub to simply populate your cells with VLookup (instead of having the sub do the math) You'll need an Array Formula that can do it.

I'm sure someone here can give you a nice short array formula to do that. (SEE ABOVE) I cobbled this together from a search on the Web.

I only did one 'IF' with the Select Case routine, I leave the rest to you...

PS If you want the array formula to pick out further occurences you change # in the formula:

=INDEX(Sheet1!A3:C17,SMALL(IF(Sheet1!A3:Sheet1!A3:C17="Apples",ROW(Sheet1!A 3:C17)-ROW(Sheet1!A3)+1,ROW(Sheet1!C17)+1),#),2)

ie: 2 finds the 2nd occurence, 3 the third, etc

Then you add this to what's already there...

If you enter it onto your sheet you must confirm with <Ctrl> +<Shift? + <Enter> (not <Enter>).

If there are less occurences than what's in the formula you'll get an error...

I don't know what your goal is with this or I might suggest a Sub that does the math (automatically) rather than one that puts formulas in cells - or perhaps one that does a combination of the two.

Good Luck!



I used:

- Set ranges with Offset(Row,Column) to move the ranges

- The M$ 'Find' example to find how many occurences of each value.

- Arrays to hold the values to find and how many times they were found

-Select Case to respond to finds 1, 2 or 3

- A kludge to enter the long Array Formulas


[vba]
Option Explicit
Sub Sort()

'For M$ loop
Dim c As Range
Dim firstaddress As String

'//Added. Undimensioned arrays
Dim Arr As Variant
Dim Arr2 As Variant

'counters for loops
Dim i As Long
Dim j As Long

'For long formula (255 +)
Dim theFormulaPart1 As String
Dim theFormulaPart2 As String
Dim theFormulaPart3 As String

Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range

Dim Ws1 As Worksheet
Dim Ws2 As Worksheet

Set Ws1 = Sheets("Sheet1")
Set Ws2 = Sheets("Sheet2")

'//Added. Using Ranges can simplify the changing
' of the code at a later date.
'Range on Sheet 1 to look in for Sales
Set rng1 = Ws1.Range("B3")
'Range on Sheet 2 to put Formulas
Set rng2 = Ws2.Range("B3")
'Range on Sheet 2 to put Headers
Set rng3 = Ws2.Range("A3")

'//Added for 'Find'. Populate array

'Populate array
Arr = Array("Apples", "Melons", "Onions", "Tomatoes")

'Make array same size
ReDim Arr2(UBound(Arr))

'Speed
Application.ScreenUpdating = False
'Handle errors
'On Error GoTo endo

With Ws2

'This will put the array values in the Cells
For i = LBound(Arr) To UBound(Arr)
rng3.Offset(i, 0) = Arr(i)
Next i
'This works off of the counter value
rng3.Offset(i, 0) = "Total"
rng3.Offset(i, 1) = "=SUM(B3:B5)"

.Columns("A:A").EntireColumn.AutoFit
.Range("A2").Font.Bold = True
.Range("A2:B2").MergeCells = True
.Range("A2:B2").HorizontalAlignment = xlCenter

'//Find multiple occurences of array values
For i = LBound(Arr) To UBound(Arr)
'Look in Sheet 1 Col a
With Ws1.Columns("A:A")
'What to look for
Set c = .Find(Arr(i), LookIn:=xlValues)
'Found it
If Not c Is Nothing Then
'Save to check final occurence
firstaddress = c.Address
Do
'Put number in arr2, add if found again
Arr2(j) = Arr2(j) + 1
'Look for value again
Set c = .FindNext(c)
'Find all till found first one again, then do next
Loop While Not c Is Nothing And c.Address <> firstaddress
'Incr Arr2 storage #
j = j + 1
End If
End With
Next i

'We now have a list of multiple occurences in Arr2


'// .Offset(# of Rows, # of Columns) to move.Positive
' means down or right, negative is up or left

'//Using Offset to move Across cols from the original range
If rng1 > 0 And rng1.Offset(0, 1) = 0 Then
'Check if only one occurence off "Apples was found
If Arr2(0) = 1 Then
'Yes
rng2 = "=VLOOKUP(A3, Sheet1!A:B, 2, 0)"
Else
'More than one
Select Case Arr2(0)
'Was two occurences of "Apples" found
Case Is = 2
'This one is not too long
rng2.FormulaArray = "=VLOOKUP(A3, Sheet1!A:B, 2, 0)+INDEX(Sheet1!A3:C18,SMALL(IF(Sheet1!A3:C18=""Apples"",ROW(Sheet1!A3:C18)-ROW(Sheet1!A3)+1,ROW(Sheet1!C18)+1),2),2)"
'Was three
Case Is = 3
'This one is too long so trick Excel into accepting it
theFormulaPart1 = "=INDEX(Sheet1!A3:C18,SMALL(IF(Sheet1!A3:C18=""Apples"",ROW(Sheet1!A3:C 18)-ROW(Sheet1!A3)+1,ROW(Sheet1!C18)+1),2),2)+999"
theFormulaPart2 = "+INDEX(Sheet1!A3:C18,SMALL(IF(Sheet1!A3:C18=""Apples"",ROW(Sheet1!A3:C 18)-ROW(Sheet1!A3)+1,ROW(Sheet1!C18)+1),3),2)+9999"
theFormulaPart3 = "+VLOOKUP(A3, Sheet1!A:C, 2, 0)"
'Put piece in cell
rng2.FormulaArray = theFormulaPart1
'Add to Array formula by using 'Replace'
rng2.Replace "+999", theFormulaPart2
rng2.Replace "+9999", theFormulaPart3
'Et cetera
'Case Is = 4

'If the 'Case' is not covered here (a just in case Case <G>
Case else
'If the
End Select
End If
'//Using Offset to move down rows from the original range
rng2.Offset(1, 0) = "=VLOOKUP(A4, Sheet1!A:B, 2, 0)"
rng2.Offset(2, 0) = "=VLOOKUP(A5, Sheet1!A:B, 2, 0)"
rng2.Offset(3, 0) = "=VLOOKUP(A6, Sheet1!A:B, 2, 0)"
rng2.Offset(-1, -1) = "January 2008 Orders"

'<Snip>

Else
MsgBox ("Orders cannot be calculated")
End If
End With

'Delete
Set Ws1 = Nothing
Set Ws2 = Nothing

'Reset
Application.ScreenUpdating = True

'Normal exit
Exit Sub

'Errored out
endo:
'Reset
Application.ScreenUpdating = True

'Inform the user
MsgBox ("Error! " & Err.Number & " " & Err.Description)

End Sub


[/vba]

[rbrhodes]

Hi cmm,

I look at that and although there is a lot of stuff in there to study, it doesn't really help you. (I'm embarrased I wote that!)

In lieu of apology, here's a WorkBook that does what you need. (There's lots of stuff to study in it as well, number 1 being avoid repetition at all costs! Look for repeating instances of the same code and then use variables in for the minor changes. This makes editing easier as well as avoiding typing and the inevitable 'misteakes' in entering data repeatedly)

Conact me or post back with any questions or bugs!