PDA

View Full Version : Solved: Scrolling in Form threw rows



Emoncada
04-10-2007, 12:58 PM
I would like to know if I can make two arrows Right and Left to view data from a spreadsheet row to row.
I have this code
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Const WS_RANGE As String = "C1:C20" '<== change to suit


If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
ServerBuild.TxtName.Value = Me.Cells(.Row, 1)
ServerBuild.LblDate.Caption = Me.Cells(.Row, 2)
ServerBuild.TxtServerName.Value = Me.Cells(.Row, 3)
ServerBuild.TxtLocation.Value = Me.Cells(.Row, 4)

'ServerBuild.LblML370G4.Caption = Me.Cells(.Row, 5)
'ServerBuild.LblML370G5.Caption = Me.Cells(.Row, 5)
If Me.Cells(.Row, 5) = ServerBuild.LblML370G4.Caption Then
ServerBuild.ButtonG4.Value = True
Else
ServerBuild.ButtonG5.Value = True
End If

ServerBuild.TxtCtsContact.Value = Me.Cells(.Row, 6)
ServerBuild.TxtTracking.Value = Me.Cells(.Row, 7)

If Me.Cells(.Row, 8).Value = ServerBuild.Lbl728GB.Caption Then
ServerBuild.Button72.Value = True
Else
ServerBuild.Button146.Value = True
End If

ServerBuild.TxtDrive1SN.Value = Me.Cells(.Row, 9)
ServerBuild.TxtDrive2SN.Value = Me.Cells(.Row, 10)
ServerBuild.TxtDrive3SN.Value = Me.Cells(.Row, 11)
ServerBuild.TxtDrive4SN.Value = Me.Cells(.Row, 12)

If Me.Cells(.Row, 13) = "a" Then
ServerBuild.ChkBox1721.Value = True
Else
ServerBuild.ChkBox1721.Value = False
End If
If Me.Cells(.Row, 14) = "a" Then
ServerBuild.ChkBox2811.Value = True
Else
ServerBuild.ChkBox2811.Value = False
End If
If Me.Cells(.Row, 15) = "a" Then
ServerBuild.ChkBox2620.Value = True
Else
ServerBuild.ChkBox2620.Value = False
End If

If Me.Cells(.Row, 16) = ServerBuild.Lbl3550.Caption Then
ServerBuild.Button3550.Value = True
Else
ServerBuild.Button3550.Value = False
End If
If Me.Cells(.Row, 16) = ServerBuild.Lbl3560.Caption Then
ServerBuild.Button3560.Value = True
Else
ServerBuild.Button3560.Value = False
End If

If Me.Cells(.Row, 17) = ServerBuild.LblCSU.Caption Then
ServerBuild.ChkBoxCSU.Value = True
Else
ServerBuild.ChkBoxCSU.Value = False
End If

ServerBuild.TxtFinalStatus.Value = Me.Cells(.Row, 18)
ServerBuild.TxtSignature.Value = Me.Cells(.Row, 19)
End With
End If
Cancel = True
ServerBuild.Show
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C:C"
Application.EnableEvents = False

On Error GoTo ws_exit
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Target.AddComment.Text Text:="Double-Click Cell to View Form With this Server Information!" & Chr(10)
With Target.Comment.Shape.TextFrame.Characters.Font
.Name = "Garamond"
.Bold = True
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub


Can I make that happen?

mdmackillop
04-10-2007, 01:04 PM
If you added in a global variable (say Rw) to your code

ServerBuild.TxtName.Value = Me.Cells(.Row, Rw + 1)
you could use the arrows to change Rw so returning adjacent values.

feathers212
04-10-2007, 01:06 PM
Just a quick thought. Why not make a variable that holds the row value? When you click on the left and right arrows (create as command buttons) have the row variable increase or decrease respectively to reference the row value? Additionally, the command button click would then load the values for that specific row.

Just a thought....not totally sure how this could be done.

Emoncada
04-10-2007, 01:19 PM
Feathers212 that is want I would like I also don't know if that could happen. mdmackillop Can that be done? Is that possible?

Emoncada
04-10-2007, 01:26 PM
I created two CmdButtons
CmdButtonLeft & CmdButtonRight If that helps.

mdmackillop
04-10-2007, 01:57 PM
Here's a simple example

Emoncada
04-10-2007, 02:39 PM
I tried using the vb from that example, changing things to match my data, but it's not working. This is my Code
Form Vb
Private Sub CmdButtonLeft_Click()
If CmdButtonLeft.Value = 0 Then Exit Sub
Row = Row + CmdButtonLeft.Value
CmdButtonLeft.Value = 0
GetData
End Sub
Private Sub CmdButtonRight_Change()
If CmdButtonRight.Value = 0 Then Exit Sub
Row = Row + CmdButtonRight.Value
CmdButtonRight.Value = 0
GetData
End Sub
Private Sub CmdComplete_Click()
TxtFinalStatus = "Complete"
End Sub
Private Sub CmdSavePrint_Click()

LblDate.Caption = Format(Now, "mm/dd/yyyy") & " " & Format(Now, "hh:mm:ss AM/PM")

'Add New Button to your UserForm so you press to Apply Data to Sheet
Dim RowNext As Integer

'last row of data puls one row
RowNext = Worksheets("Server Build Template").Cells(65536, 1).End(xlUp).Row + 1

'Cells(Row Number,Column Number)
With Worksheets("Server Build Template")
.Cells(RowNext, 1) = TxtName.Value
.Cells(RowNext, 2) = LblDate.Caption
.Cells(RowNext, 3) = TxtServerName.Value
.Cells(RowNext, 4) = TxtLocation.Value

If Me.ButtonG4 = True Then .Cells(RowNext, 5) = Me.LblML370G4.Caption
If Me.ButtonG5 = True Then .Cells(RowNext, 5) = Me.LblML370G5.Caption

.Cells(RowNext, 6) = TxtCtsContact.Value
.Cells(RowNext, 7) = TxtTracking.Value

If Me.Button72 = True Then .Cells(RowNext, 8) = Me.Lbl728GB.Caption
If Me.Button146 = True Then .Cells(RowNext, 8) = Me.Lbl146GB.Caption

.Cells(RowNext, 9) = TxtDrive1SN.Value
.Cells(RowNext, 10) = TxtDrive2SN.Value
.Cells(RowNext, 11) = TxtDrive3SN.Value
.Cells(RowNext, 12) = TxtDrive4SN.Value

If Me.ChkBox1721 = True Then .Cells(RowNext, 13) = "a"
If Me.ChkBox2811 = True Then .Cells(RowNext, 14) = "a"
If Me.ChkBox2620 = True Then .Cells(RowNext, 15) = "a"

If Me.Button3550 = True Then .Cells(RowNext, 16) = Me.Lbl3550.Caption
If Me.Button3560 = True Then .Cells(RowNext, 16) = Me.Lbl3560.Caption

If Me.ChkBoxCSU = True Then .Cells(RowNext, 17) = Me.LblCSU.Caption

.Cells(RowNext, 18) = TxtFinalStatus.Value
.Cells(RowNext, 19) = TxtSignature.Value
End With
ServerBuild.PrintForm

'You can't save a worksheet
ActiveWorkbook.Save

ServerBuild.CmdClear = True


End Sub
Private Sub CmdClose_Click()
Unload ServerBuild
End Sub
Private Sub CmdClear_Click()
TxtName.Value = ""
LblDate.Caption = ""
TxtServerName.Value = ""
TxtLocation.Value = ""
TxtCtsContact.Value = ""
TxtTracking.Value = ""
Me.ButtonG4 = False
Me.ButtonG5 = False
Me.Button146 = False
Me.Button72 = False
TxtDrive1SN.Value = ""
TxtDrive2SN.Value = ""
TxtDrive3SN.Value = ""
TxtDrive4SN.Value = ""
Me.ChkBox1721.Value = False
Me.ChkBox2811.Value = False
Me.ChkBox2620.Value = False
Me.Button3550.Value = False
Me.Button3560.Value = False
Me.ChkBoxCSU.Value = False
TxtFinalStatus.Value = ""
TxtSignature.Value = ""
TxtName.SetFocus
End Sub
Private Sub CmdSign_Click()
TxtSignature = TxtName.Value
End Sub

Option Explicit
Public Row As Long
Sub GetData(Optional Target As Range)
ServerBuild.CmdButtonLeft.Value = 0
If Not Target Is Nothing Then
Row = Target.Row
End If
If Row <= 0 Then Exit Sub
With ServerBuild
'Example from other sheet

'.TextBox1.Text = Cells(1, Col)

.TxtName.Value = Cells(Row, 1)
.LblDate.Caption = Cells(Row, 2)
.TxtServerName.Value = Cells(Row, 3)
.TxtLocation.Value = Cells(Row, 4)

'If Me.ButtonG4 = True Then .Cells(RowNext, 5) = Me.LblML370G4.Caption
'If Me.ButtonG5 = True Then .Cells(RowNext, 5) = Me.LblML370G5.Caption

.TxtCtsContact.Value = Cells(Row, 6)
'.Cells(RowNext, 7) = TxtTracking.Value

'If Me.Button72 = True Then .Cells(RowNext, 8) = Me.Lbl728GB.Caption
'If Me.Button146 = True Then .Cells(RowNext, 8) = Me.Lbl146GB.Caption

.TxtDrive1SN.Value = Cells(Row, 9)
.TxtDrive2SN.Value = Cells(Row, 10)
.TxtDrive3SN.Value = Cells(Row, 11)
.TxtDrive4SN.Value = Cells(Row, 12)

' If Me.ChkBox1721 = True Then .Cells(RowNext, 13) = "a"
' If Me.ChkBox2811 = True Then .Cells(RowNext, 14) = "a"
' If Me.ChkBox2620 = True Then .Cells(RowNext, 15) = "a"

' If Me.Button3550 = True Then .Cells(RowNext, 16) = Me.Lbl3550.Caption
' If Me.Button3560 = True Then .Cells(RowNext, 16) = Me.Lbl3560.Caption

' If Me.ChkBoxCSU = True Then .Cells(RowNext, 17) = Me.LblCSU.Caption

.TxtFinalStatus.Value = Cells(Row, 18)
.TxtSignature.Value = Cells(Row, 19)
End With
End Sub


I'm Just having problems with this part because I already have a
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
Cancel = True
GetData Target
UserForm1.Show
End Sub

mdmackillop
04-10-2007, 03:23 PM
I'll have a look tomorrow.

feathers212
04-10-2007, 04:16 PM
In mdmackillop's example, he uses a spin button control. This is one control. In your form you are attempting to use two different command button controls. Mdmackillop's coding will not work with this. I have made some changes to his coding that will let you use the two different command buttons if that is the way that you wish to proceed. Here is my example:

5445

Emoncada
04-11-2007, 01:31 PM
That seems to work feathers is there a way for it to stop when next row is empty?

Charlize
04-11-2007, 02:15 PM
Try this version ...

Charlize

mdmackillop
04-11-2007, 02:22 PM
Hi Charlize
Quite neat. How about adding a few comments and submitting this as a KB item. (Don't forget your Option Explicit in the form code)
Regards
Malcolm

Emoncada
04-11-2007, 06:17 PM
Very nice that works great Thanks.

Emoncada
04-12-2007, 07:00 AM
I am getting an error now that i am testing it with my spreadsheet.
Im getting a
Compile Error:

Ambiguous name detected: GetData

Any Idea why I would get that?

my VB
Private Sub CmdButtonRight_Click()
RowNum = RowNum + 1
If Cells(RowNum, 1).Value <> vbNullString Then
GetData Cells(RowNum, 1)
Me.Caption = "Record no.: " & RowNum - 1
Else
Beep
RowNum = RowNum - 1
Me.Caption = "Last record in database !!!"
End If
End Sub
Private Sub CmdButtonLeft_Click()
If RowNum = 2 Then
RowNum = 2
Beep
Me.Caption = "First record in database !!!"
Else
RowNum = RowNum - 1
Me.Caption = "Record no.: " & RowNum - 1
End If
GetData Cells(RowNum, 1)
End Sub
Private Sub ServerBuild_Activate()
Me.Caption = "Record no.: " & RowNum - 1
End Sub
Private Sub CmdComplete_Click()
TxtFinalStatus = "Complete"
End Sub
Private Sub CmdSavePrint_Click()

LblDate.Caption = Format(Now, "mm/dd/yyyy") & " " & Format(Now, "hh:mm:ss AM/PM")

'Add New Button to your UserForm so you press to Apply Data to Sheet
Dim RowNext As Integer

'last row of data puls one row
RowNext = Worksheets("Server Build Template").Cells(65536, 1).End(xlUp).Row + 1

'Cells(Row Number,Column Number)
With Worksheets("Server Build Template")
.Cells(RowNext, 1) = TxtName.Value
.Cells(RowNext, 2) = LblDate.Caption
.Cells(RowNext, 3) = TxtServerName.Value
.Cells(RowNext, 4) = TxtLocation.Value

If Me.ButtonG4 = True Then .Cells(RowNext, 5) = Me.LblML370G4.Caption
If Me.ButtonG5 = True Then .Cells(RowNext, 5) = Me.LblML370G5.Caption

.Cells(RowNext, 6) = TxtCtsContact.Value
.Cells(RowNext, 7) = TxtTracking.Value

If Me.Button72 = True Then .Cells(RowNext, 8) = Me.Lbl728GB.Caption
If Me.Button146 = True Then .Cells(RowNext, 8) = Me.Lbl146GB.Caption

.Cells(RowNext, 9) = TxtDrive1SN.Value
.Cells(RowNext, 10) = TxtDrive2SN.Value
.Cells(RowNext, 11) = TxtDrive3SN.Value
.Cells(RowNext, 12) = TxtDrive4SN.Value

If Me.ChkBox1721 = True Then .Cells(RowNext, 13) = "a"
If Me.ChkBox2811 = True Then .Cells(RowNext, 14) = "a"
If Me.ChkBox2620 = True Then .Cells(RowNext, 15) = "a"

If Me.Button3550 = True Then .Cells(RowNext, 16) = Me.Lbl3550.Caption
If Me.Button3560 = True Then .Cells(RowNext, 16) = Me.Lbl3560.Caption

If Me.ChkBoxCSU = True Then .Cells(RowNext, 17) = Me.LblCSU.Caption

.Cells(RowNext, 18) = TxtFinalStatus.Value
.Cells(RowNext, 19) = TxtSignature.Value
End With
ServerBuild.PrintForm

'You can't save a worksheet
ActiveWorkbook.Save

ServerBuild.CmdClear = True


End Sub
Private Sub CmdClose_Click()
Unload ServerBuild
End Sub
Private Sub CmdClear_Click()
TxtName.Value = ""
LblDate.Caption = ""
TxtServerName.Value = ""
TxtLocation.Value = ""
TxtCtsContact.Value = ""
TxtTracking.Value = ""
Me.ButtonG4 = False
Me.ButtonG5 = False
Me.Button146 = False
Me.Button72 = False
TxtDrive1SN.Value = ""
TxtDrive2SN.Value = ""
TxtDrive3SN.Value = ""
TxtDrive4SN.Value = ""
Me.ChkBox1721.Value = False
Me.ChkBox2811.Value = False
Me.ChkBox2620.Value = False
Me.Button3550.Value = False
Me.Button3560.Value = False
Me.ChkBoxCSU.Value = False
TxtFinalStatus.Value = ""
TxtSignature.Value = ""
TxtName.SetFocus
End Sub
Private Sub CmdSign_Click()
TxtSignature = TxtName.Value
End Sub

Module
Option Explicit
Public RowNum As Integer
Sub GetData(Optional Target As Range)

If Not Target Is Nothing And Target(, 1).Value <> vbNullString Then
RowNum = Target.Row
Else
RowNum = Target.Row
Do While Cells(RowNum, 1).Value = vbNullString
RowNum = RowNum - 1
Loop
End If

With ServerBuild
'.TxtName.Value = Cells(RowNum, 2)

.TxtName.Value = Cells(Row, 1)
.LblDate.Caption = Cells(Row, 2)
.TxtServerName.Value = Cells(Row, 3)
.TxtLocation.Value = Cells(Row, 4)

If Me.ButtonG4 = True Then Me.LblML370G4.Caption = Cells(Row, 5)
If Me.ButtonG5 = True Then Me.LblML370G5.Caption = Cells(Row, 5)

.TxtCtsContact.Value = Cells(Row, 6)
.TxtTracking.Value = Cells(Row, 7)

If Me.Button72 = True Then Me.Lbl728GB.Caption = Cells(Row, 8)
If Me.Button146 = True Then Me.Lbl146GB.Caption = Cells(Row, 8)

.TxtDrive1SN.Value = Cells(Row, 9)
.TxtDrive2SN.Value = Cells(Row, 10)
.TxtDrive3SN.Value = Cells(Row, 11)
.TxtDrive4SN.Value = Cells(Row, 12)

'If Me.ChkBox1721 = True Then .Cells(RowNext, 13) = "a"
'If Me.ChkBox2811 = True Then .Cells(RowNext, 14) = "a"
'If Me.ChkBox2620 = True Then .Cells(RowNext, 15) = "a"

If Me.Button3550 = True Then Me.Lbl3550.Caption = Cells(Row, 16)
If Me.Button3560 = True Then Me.Lbl3560.Caption = Cells(Row, 16)

If Me.ChkBoxCSU = True Then Me.LblCSU.Caption = Cells(Row, 17)

.TxtFinalStatus.Value = Cells(Row, 18)
.TxtSignature.Value = Cells(Row, 19)
End With
End Sub

In Worksheet
Option Explicit
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Cancel = True
GetData Target
ServerBuild.Show

Const WS_RANGE As String = "C1:C200" '<== change to suit



If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
With Target
ServerBuild.TxtName.Value = Me.Cells(.Row, 1)
ServerBuild.LblDate.Caption = Me.Cells(.Row, 2)
ServerBuild.TxtServerName.Value = Me.Cells(.Row, 3)
ServerBuild.TxtLocation.Value = Me.Cells(.Row, 4)

'ServerBuild.LblML370G4.Caption = Me.Cells(.Row, 5)
'ServerBuild.LblML370G5.Caption = Me.Cells(.Row, 5)
If Me.Cells(.Row, 5) = ServerBuild.LblML370G4.Caption Then
ServerBuild.ButtonG4.Value = True
Else
ServerBuild.ButtonG5.Value = True
End If

ServerBuild.TxtCtsContact.Value = Me.Cells(.Row, 6)
ServerBuild.TxtTracking.Value = Me.Cells(.Row, 7)

If Me.Cells(.Row, 8).Value = ServerBuild.Lbl728GB.Caption Then
ServerBuild.Button72.Value = True
Else
ServerBuild.Button146.Value = True
End If

ServerBuild.TxtDrive1SN.Value = Me.Cells(.Row, 9)
ServerBuild.TxtDrive2SN.Value = Me.Cells(.Row, 10)
ServerBuild.TxtDrive3SN.Value = Me.Cells(.Row, 11)
ServerBuild.TxtDrive4SN.Value = Me.Cells(.Row, 12)

If Me.Cells(.Row, 13) = "a" Then
ServerBuild.ChkBox1721.Value = True
Else
ServerBuild.ChkBox1721.Value = False
End If
If Me.Cells(.Row, 14) = "a" Then
ServerBuild.ChkBox2811.Value = True
Else
ServerBuild.ChkBox2811.Value = False
End If
If Me.Cells(.Row, 15) = "a" Then
ServerBuild.ChkBox2620.Value = True
Else
ServerBuild.ChkBox2620.Value = False
End If

If Me.Cells(.Row, 16) = ServerBuild.Lbl3550.Caption Then
ServerBuild.Button3550.Value = True
Else
ServerBuild.Button3550.Value = False
End If
If Me.Cells(.Row, 16) = ServerBuild.Lbl3560.Caption Then
ServerBuild.Button3560.Value = True
Else
ServerBuild.Button3560.Value = False
End If

If Me.Cells(.Row, 17) = ServerBuild.LblCSU.Caption Then
ServerBuild.ChkBoxCSU.Value = True
Else
ServerBuild.ChkBoxCSU.Value = False
End If

ServerBuild.TxtFinalStatus.Value = Me.Cells(.Row, 18)
ServerBuild.TxtSignature.Value = Me.Cells(.Row, 19)
End With
End If
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
Const WS_RANGE As String = "C:C"
Application.EnableEvents = False

On Error GoTo ws_exit
If Not Intersect(Target, Me.Range(WS_RANGE)) Is Nothing Then
Target.AddComment.Text Text:="Double-Click Cell to View Form With this Server Information!" & Chr(10)
With Target.Comment.Shape.TextFrame.Characters.Font
.Name = "Garamond"
.Bold = True
End With
End If
ws_exit:
Application.EnableEvents = True
End Sub

lucas
04-12-2007, 08:51 AM
Do you have the sub GetData in another module somewhere?

It would help if you could post the workbook to save us from having to recreate the userform, etc.

Emoncada
04-12-2007, 09:05 AM
Your right Lucas I had in another module GetData deleted it and works only having issues with the Me Keyword.

Im getting an Invalid Use of Me Keyword.

lucas
04-12-2007, 09:14 AM
Well I'm not sure where and you didn't tell me so I guess I'll guess.......
from the module getdata:
If Me.Button3550 = True Then Me.Lbl3550.Caption = Cells(Row, 16)

If the code is not part of an object such as a form or spreadsheet.....then me is fairly ambiguous too.....
try referencing the object directly:
If Userform1.Button3550 = True Then Userform1.Lbl3550.Caption = Cells(Row, 16)

Emoncada
04-12-2007, 09:42 AM
Nice How can i have it test if both are false to leave blank

Like for this one that is a group
If Cells(RowNum, 16).Value = ServerBuild.Lbl3550.Caption Then
ServerBuild.Button3550.Value = True
Else
ServerBuild.Button3560.Value = True
End If


I would need first to test if both are false right?