Hi;
I'm trying to modify this macro to automatically scroll to the active field when the value I select from a list in a combobox is used. The cursor will o to the right field, but the focus is not set to have the scroll automatically active to bring it down to the right position. Macro is posted below:
Sub SearchProducts()
Dim searchValue
Dim counter As Integer, sheetCount As Integer
Dim startSheet, startCell
Application.ScreenUpdating = False
On Error Resume Next
startCell = ActiveCell.Address
startSheet = ActiveSheet.Name
searchValue = ActiveSheet.ComboBox1.Value
If searchValue = "" Then Exit Sub
If IsError(CDbl(searchValue)) = False Then searchValue = CDbl(searchValue)
sheetCount = ActiveWorkbook.Sheets.Count
counter = 1
Do Until counter > sheetCount
Sheets(counter).Activate
Cells.Find(What:=searchValue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Activate
If ActiveCell.Value = searchValue Then Exit Do
counter = counter + 1
Loop
If ActiveCell.Value <> searchValue Then
MsgBox "The value " & Chr(34) & searchValue & Chr(34) & " was not found.", vbExclamation + vbOKOnly, "Data not found!"
Application.Goto Reference:=Range(ActiveSheet.ActiveCell)
Application.ScreenUpdating = True
Exit Sub
End If
Application.ScreenUpdating = True
Application.Goto Reference:=ActiveSheet.ActiveCell.Range("activecell").Select, Scroll:=True
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target _
As Range, Cancel As Boolean)
Cancel = True
If ActiveSheet.ScrollArea = "" Then
ActiveSheet.ScrollArea = "range1"
Else
ActiveSheet.ScrollArea = ""
End If
End Sub
I'm trying to modify this macro to automatically scroll to the active field when the value I select from a list in a combobox is used. The cursor will o to the right field, but the focus is not set to have the scroll automatically active to bring it down to the right position. Macro is posted below:
Sub SearchProducts()
Dim searchValue
Dim counter As Integer, sheetCount As Integer
Dim startSheet, startCell
Application.ScreenUpdating = False
On Error Resume Next
startCell = ActiveCell.Address
startSheet = ActiveSheet.Name
searchValue = ActiveSheet.ComboBox1.Value
If searchValue = "" Then Exit Sub
If IsError(CDbl(searchValue)) = False Then searchValue = CDbl(searchValue)
sheetCount = ActiveWorkbook.Sheets.Count
counter = 1
Do Until counter > sheetCount
Sheets(counter).Activate
Cells.Find(What:=searchValue, After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlWhole, _
SearchOrder:=xlByColumns, SearchDirection:=xlNext, MatchCase:=False).Activate
If ActiveCell.Value = searchValue Then Exit Do
counter = counter + 1
Loop
If ActiveCell.Value <> searchValue Then
MsgBox "The value " & Chr(34) & searchValue & Chr(34) & " was not found.", vbExclamation + vbOKOnly, "Data not found!"
Application.Goto Reference:=Range(ActiveSheet.ActiveCell)
Application.ScreenUpdating = True
Exit Sub
End If
Application.ScreenUpdating = True
Application.Goto Reference:=ActiveSheet.ActiveCell.Range("activecell").Select, Scroll:=True
End Sub
Private Sub Worksheet_BeforeRightClick(ByVal Target _
As Range, Cancel As Boolean)
Cancel = True
If ActiveSheet.ScrollArea = "" Then
ActiveSheet.ScrollArea = "range1"
Else
ActiveSheet.ScrollArea = ""
End If
End Sub