Results 1 to 3 of 3

Userform coding can find data but won't update it

Threaded View

  1. #1
    Forum Contributor
    Join Date
    09-14-2012
    Location
    Tucson, Arizona, USA
    MS-Off Ver
    Office 2010
    Posts
    105

    Userform coding can find data but won't update it

    I've been working on a userform that I can use to update information on my spreadsheet but have run into a stumbling block, it will find the information I'm looking for but it won't update it. I've got a seperate userform for entering the data into the spreadsheet and modified its the coding several times to get my search and update userform (different beast altogether now), but keep running into the same problem each time. I've included my file and the coding for the search and update below. I've only managed to learn enough VBA so far to work on this project, so I'm pretty sure I've missed something obvious here.

    ThermalTestv2.xlsm

    Option Explicit
    
    Private Sub cmdReplace_Click()
    Dim rfound As Range, sFind As String
          With Me
            If .txtTime.Value <> "" Then
                sFind = .cboDate.Value
           End If
        End With
        With Sheets(1)
            Set rfound = .Columns(14).Find(what:=sFind, After:=.Cells(1, 14), LookIn:=xlValues _
                , LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext)
             Cells.FindNext
            If Not rfound Is Nothing Then
                .Cells(ActiveCell.Row, 2) = Me.txtTime.Text
                .Cells(ActiveCell.Row, 3) = Me.txtChWtrSup.Value
                .Cells(ActiveCell.Row, 4) = Me.txtChWtrRet.Value
                .Cells(ActiveCell.Row, 5) = Me.txtConWtrRet.Value
                .Cells(ActiveCell.Row, 6) = Me.txtConWtrSup.Value
                .Cells(ActiveCell.Row, 7) = Me.txtHeatWtrSup.Value
                .Cells(ActiveCell.Row, 8) = Me.txtHeatWtrRet.Value
                .Cells(ActiveCell.Row, 9) = Me.txtSluHeatSup.Value
                .Cells(ActiveCell.Row, 10) = Me.txtSluHeatRet.Value
                .Cells(ActiveCell.Row, 11) = Me.txtWstHeatSup.Value
                .Cells(ActiveCell.Row, 12) = Me.txtWstHeatRet.Value
                .Cells(ActiveCell.Row, 13) = Me.txtDomHWtrRet.Value
                .Cells(ActiveCell.Row, 14) = Me.txtDomColdWtr.Value
                .Cells(ActiveCell.Row, 15) = Me.txtDomHWtrSup.Value
                .Cells(ActiveCell.Row, 18) = Environ("Username")
                .Cells(ActiveCell.Row, 19) = Now
             End If
             End With
    End Sub
    
    Private Sub cmdNext_Click()
     Dim MyName As String, myRange As Range
       With Sheets("Thermals")
       On Error GoTo ende:
        Cells.Find(what:=cboDate.Value, After:=ActiveCell, LookIn:=xlValues, LookAt:= _
            xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=True _
            , SearchFormat:=True).Activate
            On Error Resume Next
                txtTime.Value = Cells(ActiveCell.Row, 3).Text
                txtChWtrSup.Value = Cells(ActiveCell.Row, 4)
                txtChWtrRet.Value = Cells(ActiveCell.Row, 5)
                txtConWtrRet.Value = Cells(ActiveCell.Row, 6)
                txtConWtrSup.Value = Cells(ActiveCell.Row, 7)
                txtHeatWtrSup.Value = Cells(ActiveCell.Row, 8)
                txtHeatWtrRet.Value = Cells(ActiveCell.Row, 9)
                txtSluHeatSup.Value = Cells(ActiveCell.Row, 10)
                txtSluHeatRet.Value = Cells(ActiveCell.Row, 11)
                txtWstHeatSup.Value = Cells(ActiveCell.Row, 12)
                txtWstHeatRet.Value = Cells(ActiveCell.Row, 13)
                txtDomHWtrRet.Value = Cells(ActiveCell.Row, 14)
                txtDomColdWtr.Value = Cells(ActiveCell.Row, 15)
                txtDomHWtrSup.Value = Cells(ActiveCell.Row, 16)
          End With
    ende:
    End Sub
    
    Private Sub cboDate_Change()
    Dim MyName As String, myRange As Range, found As Object
       MyName = Me.cboDate.Text
       Set myRange = ThisWorkbook.Sheets("Thermals").Range("B:B")
       Set found = myRange.Find(MyName, LookIn:=xlValues, LookAt:=xlWhole)
       If Not found Is Nothing Then
            Me.txtTime = found.Offset(, 1).Text
            Me.txtChWtrSup = found.Offset(, 2)
            Me.txtChWtrRet = found.Offset(, 3)
            Me.txtConWtrRet = found.Offset(, 4)
            Me.txtConWtrSup = found.Offset(, 5)
            Me.txtHeatWtrSup = found.Offset(, 6)
            Me.txtHeatWtrRet = found.Offset(, 7)
            Me.txtSluHeatSup = found.Offset(, 8)
            Me.txtSluHeatRet = found.Offset(, 9)
            Me.txtWstHeatSup = found.Offset(, 10)
            Me.txtWstHeatRet = found.Offset(, 11)
            Me.txtDomHWtrRet = found.Offset(, 12)
            Me.txtDomColdWtr = found.Offset(, 13)
            Me.txtDomHWtrSup = found.Offset(, 14)
       Else
            Me.txtTime = ""
            Me.txtChWtrSup = ""
            Me.txtChWtrRet = ""
            Me.txtConWtrRet = ""
            Me.txtConWtrSup = ""
            Me.txtHeatWtrSup = ""
            Me.txtHeatWtrRet = ""
            Me.txtSluHeatSup = ""
            Me.txtSluHeatRet = ""
            Me.txtWstHeatSup = ""
            Me.txtWstHeatRet = ""
            Me.txtDomHWtrRet = ""
            Me.txtDomColdWtr = ""
            Me.txtDomHWtrSup = ""
          End If
         cmdNext_Click
    End Sub
    
    Private Sub UserForm_Initialize()
      cboDate.SetFocus
      Me.cboDate.Value = Format(Date, "Medium Date")
    'Populate the Date Combobox
      Dim rngDate As Range
      Dim ws As Worksheet
      Set ws = Worksheets("DateTime")
      For Each rngDate In ws.Range("DateList")
        Me.cboDate.AddItem rngDate.Text
      Next rngDate
    End Sub
    
    Private Sub cmdClose_Click()
      Sheets("Thermals").Select
      Unload Me
    End Sub
    
    Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
      If CloseMode = vbFormControlMenu Then
        Cancel = True
        MsgBox "Please use the 'Close' button!"
      End If
    End Sub
    Last edited by LoneWolf3574; 12-26-2012 at 12:33 AM. Reason: typos & wrong file

Thread Information

Users Browsing this Thread

There are currently 1 users browsing this thread. (0 members and 1 guests)

Bookmarks

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts

Search Engine Friendly URLs by vBSEO 3.6.0 RC 1