Hi All,
Really need some expertise here, I have made an interactive “do-to list” using acontrol form scroll bar. I know this is frowned upon but I did this using merged cells. It has worked so far and I am soooo close to making all the moving parts work together except for one item. The comment section is constantly being updated, which ruins the effect of the scroll bar.
My merged cells for the entire scroll bar section is O156:X167 and it is getting the copied data to scroll from cells: O172:X210 (Note: all though in this example it goes through X210 the row value could change). There are three sections within O156:X167. Titled: Status (O156:P167), Conditions (Q156:T167), and Comments (cells: U1567:X167).
My codes are shown below that all work together to make this look like an interactive scroll bar including the comments section scrolling and updating as the user makes changes or additional comments.
Here is my dilemma: The comment section when data is entered will copy over to range U172:X210 based on the corresponding conditions. This allows the comment section to change to an offset formula to allow the comments to show as if they are scrolling with the scroll bar. The codes above work great if the user always hits enter after entering text into the cells in the comments section. The problem is, what if the user does not hit enter after entering a comment, and goes right for the scroll bar. Then the recently entered comment is lost. Itried to enter a code in the scroll bar macro to copy data from the comment section to the correspondence section in U172:X210 but the problem is the scroll bar scrolls before the code is executed so it moves the comment section value into the wrong section in range U172:X210.
I need a work around to execute the scroll bar code before the scroll bar actually changes or some way to have the value of the comment section copied to the corresponding section in cells U172:X210. Perhaps as the user is entering the value its simultaneously being entered into U172:X210? Not sure if that is possible with excel. Any ideas are appreciated!
Really need some expertise here, I have made an interactive “do-to list” using acontrol form scroll bar. I know this is frowned upon but I did this using merged cells. It has worked so far and I am soooo close to making all the moving parts work together except for one item. The comment section is constantly being updated, which ruins the effect of the scroll bar.
My merged cells for the entire scroll bar section is O156:X167 and it is getting the copied data to scroll from cells: O172:X210 (Note: all though in this example it goes through X210 the row value could change). There are three sections within O156:X167. Titled: Status (O156:P167), Conditions (Q156:T167), and Comments (cells: U1567:X167).
My codes are shown below that all work together to make this look like an interactive scroll bar including the comments section scrolling and updating as the user makes changes or additional comments.
Code:
Sub ScrollBar_change()
Dim ws4 As Worksheet
Set ws4 = Worksheets("Practice")
Dim CDstatus As String
Dim xlrange As range, xlrange2 As range, xlrange3 As range, xlrange4 As range, xlrange5 As range, xlrange6 As range
Dim valuetofind As String, valuetofind2 As String, valuetofind3 As String, valuetofind4 As String, valuetofind5 As String, valuetofind6 As String
Dim followup As String, statusdate As String
Dim r As range, r2 As range
Dim q As range, q2 As range
Dim i As Variant, j As Variant, k As Variant, l As Variant
Dim LastRow As Long, LastRow1 As Long
Dim cell1 As range, cell2 As range, cell3 As range, cell4 As range, cell5 As range, cell6 As range
Dim com1 As range, com2 As range, com3 As range, com4 As range, com5 As range, com6 As range
Dim cell1L As range, cell2L As range, cell3L As range, cell4L As range, cell5L As range, cell6L As range
Dim cor1L As range, cor2L As range, cor3L As range, cor4L As range, cor5L As range, cor6L As range
Dim foundrow As String
Code:
[FONT=Calibri][SIZE=3][COLOR=#000000]
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000] Set cor1L = ws4.range("AB157")
ws4.range("J153").value = ws4.range("V151").value
[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]LastRow = cells(Rows.Count, "Q").End(xlUp).Row
LastRow1 = cells(Rows.Count, "U").End(xlUp).Row
inarr = range("Q156:Q167")
marr = range("Q172:Q" & LastRow)
marr1 = range("U156:U167")[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]For i = 1 To 12
For j = 1 To UBound(marr)
If inarr(i, 1) = marr(j, 1) Then
Application.EnableEvents = False
foundrow = j + 170
cor1L.value = "T" & foundrow
cells(155 + i, 21).formula = "=IF((OFFSET(" & cor1L.value & ",$V$152," & 1 & "))="""","""",(offset(" & cor1L.value & ",$V$152," & 1 & ")))"
Exit For
End If
Next j
Next i[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]ActiveSheet.range("Q152").Select[/COLOR][/SIZE][/FONT]
[FONT=Calibri][SIZE=3][COLOR=#000000]
End Sub
[/COLOR][/SIZE][/FONT]
Code:
Private Sub Worksheet_Change(ByVal target As range)
Dim ws4 As Worksheet
Set ws4 = Worksheets("Practice")
Dim CDstatus As String
Dim xlrange As range, xlrange2 As range, xlrange3 As range, xlrange4 As range, xlrange5 As range, xlrange6 As range
Dim valuetofind As String, valuetofind2 As String, valuetofind3 As String, valuetofind4 As String, valuetofind5 As String, valuetofind6 As String
Dim followup As String, statusdate As String
Dim r As range, r2 As range
Dim q As range, q2 As range
Dim LastRow As Long, LastRow1 As Long
Dim cell1 As range, cell2 As range, cell3 As range, cell4 As range, cell5 As range, cell6 As range
Dim com1 As range, com2 As range, com3 As range, com4 As range, com5 As range, com6 As range
Dim cell1L As range, cell2L As range, cell3L As range, cell4L As range, cell5L As range, cell6L As range
Dim cor1L As range, cor2L As range, cor3L As range, cor4L As range, cor5L As range, cor6L As range
Dim foundrow As String
Dim xlrange1 As range
Dim valuetofind1 As String
Dim myrange As range
Dim i As Integer, j As Integer
Dim comb_range As range
Dim inarr As Variant, marr As Variant, marr1 As Variant
Application.EnableEvents = False
Application.ScreenUpdating = False
Set cell1 = ws4.range("Q156")
Set com1 = ws4.range("U156")
Set cell1L = ws4.range("AB156")
Set cor1L = ws4.range("AB157")
Set cell3 = ws4.range("Q160")
Set com3 = cell3.Offset(0, 1)
Set cell3L = ws4.range("AB160")
Set cor3L = ws4.range("AB161")
Set cell2 = ws4.range("Q158")
Set com2 = cell2.Offset(0, 1)
Set cell2L = ws4.range("AB158")
Set cor2L = ws4.range("AB159")
Set cell4 = ws4.range("Q162")
Set com4 = cell4.Offset(0, 1)
Set cell4L = ws4.range("AB162")
Set cor4L = ws4.range("AB163")
Set cell5 = ws4.range("Q164")
Set com5 = cell5.Offset(0, 1)
Set cell5L = ws4.range("AB164")
Set cor5L = ws4.range("AB165")
Set cell6 = ws4.range("Q166")
Set com6 = cell6.Offset(0, 1)
Set cell6L = ws4.range("AB166")
Set cor6L = ws4.range("AB167")
If Not Application.Intersect(activecell, range("O156:P167")) Is Nothing Then
On Error GoTo errhandler
If activecell.value = "Complete" Or activecell.value = "Pending" Then
ws4.range("Z151").value = activecell.Address
Else
activecell.value = "Pending"
End If
begining = ws4.range("Z151").value
valuetofind = activecell.Offset(0, 1).value
Set xlrange = Worksheets("Practice").range("Q172:T300")
For Each cell In xlrange
If cell.value = valuetofind Then
If activecell.value = "Complete" Then
cell.Offset(0, -2).value = "Complete"
ElseIf activecell.value = "Pending" Then
cell.Offset(0, -2).value = "Pending"
Else
cell.Offset(0, -2).value = "Pending"
End If
cell.Offset(-1, -3).Select
ws4.range("Z152").value = activecell.Address
addr = ws4.range("Z152").value
cell.Offset(0, -3).Select
ws4.range("Z153").value = activecell.value
addr1 = ws4.range("Z153").value
End If
Next
strsheet = Worksheets("Practice").range("Z151").value
Worksheets("Practice").range(strsheet).Activate
On Error GoTo errhandler
activecell.formula = "=offset(" & addr & ",1, " & 1 & ")"
Else
End If
errhandler:
Application.EnableEvents = True
Application.ScreenUpdating = True
If Not Application.Intersect(activecell, range("U156:X168")) Is Nothing Then
LastRow = cells(Rows.Count, "Q").End(xlUp).Row
LastRow1 = cells(Rows.Count, "U").End(xlUp).Row
inarr = range("Q156:Q167")
marr = range("Q172:Q" & LastRow)
marr1 = range("U156:U167")
For i = 1 To 12
For j = 1 To UBound(marr)
If inarr(i, 1) = marr(j, 1) Then
Application.EnableEvents = False
cells(171 + j, 21) = marr1(i, 1)
Exit For
End If
Next j
Next i
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End Sub
Private Sub worksheet_selectionchange(ByVal target As range)
Set ws4 = Worksheets("Practice")
Dim CDstatus As String
Dim followup As String, statusdate As String
Dim r As range, r2 As range
Dim q As range, q2 As range
Dim i As Variant
Dim LastRow As Long
Dim cell1 As range, cell2 As range, cell3 As range, cell4 As range, cell5 As range, cell6 As range
Dim com1 As range, com2 As range, com3 As range, com4 As range, com5 As range, com6 As range
Dim cell1L As range, cell2L As range, cell3L As range, cell4L As range, cell5L As range, cell6L As range
Dim cor1L As range, cor2L As range, cor3L As range, cor4L As range, cor5L As range, cor6L As range
Dim foundrow As String
Dim xlrange As range
Dim valuetofind As String
Dim correct_value As String
Application.EnableEvents = False
Application.ScreenUpdating = False
If Not Application.Intersect(activecell, range("U156:X167")) Is Nothing Then
valuetofind = activecell.Offset(0, -4).value
Set xlrange = Worksheets("Practice").range("Q172:T300")
For Each cell In xlrange
If cell.value = valuetofind Then
foundrow = cell.Offset(0, 1).Row
ws4.range("H157").value = ("U" & foundrow)
activecell.value = ws4.range("U" & foundrow).value
Application.EnableEvents = False
End If
Next
SendKeys "{f2}"
Else
End If
Application.EnableEvents = True
Application.ScreenUpdating = True
End SubHere is my dilemma: The comment section when data is entered will copy over to range U172:X210 based on the corresponding conditions. This allows the comment section to change to an offset formula to allow the comments to show as if they are scrolling with the scroll bar. The codes above work great if the user always hits enter after entering text into the cells in the comments section. The problem is, what if the user does not hit enter after entering a comment, and goes right for the scroll bar. Then the recently entered comment is lost. Itried to enter a code in the scroll bar macro to copy data from the comment section to the correspondence section in U172:X210 but the problem is the scroll bar scrolls before the code is executed so it moves the comment section value into the wrong section in range U172:X210.
I need a work around to execute the scroll bar code before the scroll bar actually changes or some way to have the value of the comment section copied to the corresponding section in cells U172:X210. Perhaps as the user is entering the value its simultaneously being entered into U172:X210? Not sure if that is possible with excel. Any ideas are appreciated!
Last edited:
