Solved: Find Multiple Entries - Change Cell Value

[f2e4]

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]

Do you have a workbook to try with?

[f2e4]

Do you have a workbook to try with?

Hey Bob,

Please see attached file

[david000]

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

[f2e4]

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]

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

[f2e4]

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]

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.

[f2e4]

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]

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.

[f2e4]

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]

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]

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.

[f2e4]

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.....