View Full Version : Solved: Find Multiple Entries - Change Cell Value
I am using the following find code, but the program only ever finds the first entry and it takes a seriously long time to run (only 4 entries to find in 150 rows)
Sub Find_Project()
Dim R as range, rng as range, firstaddress as string
projectmenu = activesheet.combobox1.value
newstatus = activesheet.combobox2.value
With activesheet
On Error Resume Next
With .columns(3)
Set R = .Find(projectmenu, after:= Cells(3, 3))
On Error GoTo 0
If Not R is Nothing Then
firstaddress = R.address
findrow = R.row
Set rng = R
Do
With R
If. value = projectmenu Then
Cells(findrow, 6).value = newstatus
Set rng = Union(R, rng)
End If
End With
Set R = .FindNext(R) 'Seems to stall here even though the
'next 3 entries are directly below the first value
Loop Until R Is Nothing Or R.Address = firstaddress
End If
End With
End With
Set R = Nothing
Set rng = Nothing
End Sub
Can anyone help me out with this
I just want the program to find ALL occurences of the Combobox1 value in Column 3 and then in the repective cell in Column 6 to enter the value from Combobox2
Bob Phillips
08-11-2008, 04:51 AM
Do you have a workbook to try with?
Do you have a workbook to try with?
Hey Bob,
Please see attached file
david000
08-11-2008, 10:57 AM
I'm pretty sure this is still the wrong approach. So I would hold out for XLD and he my do an autofilter version for you it's a better method for this type of workbook.
Public news, proj As Variant
Sub Change_Status()
Dim FoundCell, rCell As Range
Dim strFirstAddress As String
With Sheet6
news = .ComboBox1.Value
proj = .ComboBox2.Value
With Intersect(.Columns("C:F"), .UsedRange)
Set rCell = .Find(proj, lookat:=xlWhole, LookIn:=xlValues)
If rCell Is Nothing Then
MsgBox "Sorry, no matching name was found!", vbInformation
Exit Sub
Else
strFirstAddress = rCell.Address
Set FoundCell = rCell
Do
Set rCell = .FindNext(rCell)
rCell.Offset(, 3).Value = news
Loop While Not rCell Is Nothing And rCell.Address <> strFirstAddress
End If
End With
End With
End Sub
Thanks David - I will test it out today
The code I am using at the top works fine if I need to delete entore rows but just can't seem to get it functioning for cell editing
Bob Phillips
08-12-2008, 04:17 AM
Freddy,
The problem was that in your loop you didn't increment the findrow variable, so it kept pointing at the first row found.
This works, but do you want a faster version as suggested?
Sub Change_Status()
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'STORE VALUES ENTERED
newstatus = ActiveSheet.ComboBox1.Value
projectmenu = ActiveSheet.ComboBox2.Value
'FIND PROJECT DETAILS AND UPDATE STATUS FOR WORKLOAD SHEET
Sheets("Workload").Select
Dim R As Range, rng As Range, firstaddress As String, findrow As String
With ActiveSheet
On Error Resume Next
With .Columns(3)
Set R = .Find(projectmenu, after:=Cells(3, 3), lookat:=xlWhole)
On Error GoTo 0
If Not R Is Nothing Then
firstaddress = R.Address
Do
With R
If .Value = projectmenu Then
findrow = R.Row
Cells(findrow, 6).Value = newstatus
End If
End With
Set R = .FindNext(R) 'Seems to stall here even though the
'next 3 entries are directly below the first value
Loop Until R Is Nothing Or R.Address = firstaddress
End If
End With
End With
Set R = Nothing
Set rng = Nothing
Application.ScreenUpdating = True
End Sub
Hey Bob,
Thanks for the code update - works a charm.
As you have seen from tht Resource Management program i sent you, i'm trying to make all my programs run as quickly as possible. This is mainly because other people will be using the program and no one seems to have the patience to let VBA do its thing.
How would you make the code any faster?
Would that involve using a Union and doing it all at the end rather than editing each cell as it goes along or is it something else.
Thanks again for the help
Bob Phillips
08-12-2008, 04:29 AM
No, I would filter as David suggested, it is usually the fastest way, and then editing all the filter cells in one swoop.
Sub Change_Status()
Dim newstatus, projectmenu As Variant
Dim LastRow As Long
Dim rng As Range
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
'STORE VALUES ENTERED
newstatus = ActiveSheet.ComboBox1.Value
projectmenu = ActiveSheet.ComboBox2.Value
'FIND PROJECT DETAILS AND UPDATE STATUS FOR WORKLOAD SHEET
With Sheets("Workload")
LastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Set rng = .Range("C3").Resize(LastRow - 2)
rng.AutoFilter Field:=1, Criteria1:=projectmenu
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
If Not rng Is Nothing Then
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
rng.Offset(0, 3).Value = newstatus
End If
rng.AutoFilter
End With
Set rng = Nothing
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
End Sub
I often find that user are not unwilling to wait, it is lack of fedback that hits them. In these instances, a progress bar is invaluable, you can't always make a facility fast, faster maybe, fast, maybe not.
OK guys thanks for the code, definitely helped a lot.....again.
On a different note, seeing as some of the code above does take time to process, can anyone recommend a good progress bar.
I have tried a few but could never get any to work.
Bob Phillips
08-13-2008, 04:16 AM
I normally recommend Robin Hammond's, but I see he doesn't have it on his site anymore.
The code I gave you won't benefit from a progress bar, a) because it is fast, and b) there is no loop to chart the progress of.
I normally recommend Robin Hammond's, but I see he doesn't have it on his site anymore.
The code I gave you won't benefit from a progress bar, a) because it is fast, and b) there is no loop to chart the progress of.
Maybe this should go in its own topic...
I have one section of code that creates 3 new spreadsheets, inputs formulas across 24 columns, 150 rows, then does some formatting.
I was hoping to add a progress bar to that one seeing as it takes about 30s to run and i'm sure someone will complain that it looks like excel has stalled and just sits there.
Bob Phillips
08-13-2008, 04:30 AM
I have added a progress bar to your worksheet with your (corrected) original code, that is a loop, to show you how it works. I had to put a Wait in the code, as the dataset was so small the progressbar originally just flashed.
Bob Phillips
08-13-2008, 04:40 AM
Maybe this should go in its own topic...
I have one section of code that creates 3 new spreadsheets, inputs formulas across 24 columns, 150 rows, then does some formatting.
I was hoping to add a progress bar to that one seeing as it takes about 30s to run and i'm sure someone will complain that it looks like excel has stalled and just sits there.
I would do that by using the progressbar I gave you, set the overall limit to 3, the number of sheets, and the individual limit to the number of rows. Would work well.
Thanks again Bob,
At some point, your going to have to tell me how you learnt all this stuff. I pretty much rely on learning from this site as I go along.....
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.