Update cell after update from userform

Patriot2879

Well-known Member
HI i hope you can help me with the code below as this is not working an i am trying to update a cell in a sheet called 'Data' if changes are made in my userform, my range in the 'Data' sheet my range is A1:R17 , ROWS B1:R1 have dates inand columns A2:A17 have areas in, then B2:R17 have numbers in.

In
ComboBox1 and ComboBox2 this is a lookupfor the date and area where it cross references and find the number in thecorresponding cell and put this number into TextBox53. In TextBox54 this iswhere the number can be updated. What i want is then this to update the correspondingcell from A1:R17.




- ComboBox1 contains adate matching one of the dates in B1:R1 and

- ComboBox2 contains an area matching one of the areas in A2:A17 and
- TextBox54 is entered manually


Hope you can help with the code please?


Code:
[FONT=Calibri]Option Explicit[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]Private Sub Worksheet_Change(ByVal Target As Range)[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]  Dim a() As Variant,i As Long, j As Long[/FONT]


[FONT=Calibri]  Dim sThisFullName AsString, sSynchronized As String[/FONT]


[FONT=Calibri]  Dim Wb As Workbook,IsOpen As Boolean[/FONT]


[FONT=Calibri]  Dim FullName AsVariant, FullNames As Range[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]  If Target.Address<> "TextBox54" Or Target.Value = "" Then Exit Sub[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]  ' Determine Row [URL=https://www.mrexcel.com/forum/usertag.php?do=list&action=hash&hash=and]#and[/URL]  Column #[/FONT]


[FONT=Calibri]  i = Application.Match(Range("ComboBox2"),Range("A1:A17"), 0)[/FONT]


[FONT=Calibri]  If i = 0 Then MsgBoxRange("ComboBox1") & " not found in A1:A18",vbCritical: Exit Sub[/FONT]


[FONT=Calibri]  j =Application.Match(Range("ComboBox1"), Range("A1:R18"), 0)[/FONT]


[FONT=Calibri]  If i = 0 Then[/FONT]


[FONT=Calibri]    MsgBoxRange("ComboBox2").Value & " not found in A1:A17",vbCritical[/FONT]


[FONT=Calibri]    Exit Sub[/FONT]


[FONT=Calibri]  ElseIf j = 0 Then[/FONT]


[FONT=Calibri]    MsgBoxRange("ComboBox1").Value & " not found in A1:R1",vbCritical[/FONT]


[FONT=Calibri]    Exit Sub[/FONT]


[FONT=Calibri]  End If[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]  ' Disable eventshandling, enable auto calculation[/FONT]


[FONT=Calibri] Application.EnableEvents = False[/FONT]


[FONT=Calibri] Application.Calculation = xlCalculationAutomatic[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]  ' Adjust theIntersection cell Value by substracting Input in TextBox54[/FONT]


[FONT=Calibri]  Cells(i, j).Value =Cells(i, j).Value - Target.Value[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]  ' Clear ONLY Targetcell and select it[/FONT]


[FONT=Calibri]  Target.ClearContents[/FONT]


[FONT=Calibri]  Target.Select[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]  ' Disable blinking[/FONT]


[FONT=Calibri] Application.ScreenUpdating = False[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]  i =UBound(FullNames.Value) - 1[/FONT]


[FONT=Calibri]  j = 0[/FONT]


[FONT=Calibri]  sThisFullName =LCase(ThisWorkbook.FullName)[/FONT]


[FONT=Calibri]  a() =Me("Data").Range("A1").CurrentRegion.Value[/FONT]


[FONT=Calibri]  For Each FullName InFullNames.Value[/FONT]


[FONT=Calibri]    If InStr(FullName,"") > 0 And LCase(FullName) <> sThisFullName Then[/FONT]


[FONT=Calibri]      j = j + 1[/FONT]


[FONT=Calibri]     Application.StatusBar = "Updating (" & j &"/" & i & "): " & FullName[/FONT]


[FONT=Calibri]      On Error ResumeNext[/FONT]


[FONT=Calibri]      Set Wb =Workbooks(Mid(FullName, InStrRev(FullName, "") + 1))[/FONT]


[FONT=Calibri]      IsOpen = (Err =0)[/FONT]


[FONT=Calibri]      On Error GoToexit_[/FONT]


[FONT=Calibri]      If Not IsOpenThen[/FONT]


[FONT=Calibri]        Set Wb =Workbooks.Open(FullName, UpdateLinks:=False)[/FONT]


[FONT=Calibri]      End If[/FONT]


[FONT=Calibri]      With Wb[/FONT]


[FONT=Calibri]       .Sheets("Data")(Me.Name).Range("A1").CurrentRegion.Resize(UBound(a),UBound(a, 2)).Value = a()[/FONT]


[FONT=Calibri]        .Save[/FONT]


[FONT=Calibri]        If Not IsOpenThen .Close False[/FONT]


[FONT=Calibri]      End With[/FONT]


[FONT=Calibri]      sSynchronized =sSynchronized & IIf(j > 1, vbLf, "") & FullName[/FONT]


[FONT=Calibri]    End If[/FONT]


[FONT=Calibri]  Next[/FONT]


[FONT=Calibri] ThisWorkbook.Activate[/FONT]


[FONT=Calibri]  [/FONT]


[FONT=Calibri]exit_:[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]  ' Restore eventshandling, screen updating and status bar[/FONT]


[FONT=Calibri] Application.EnableEvents = True[/FONT]


[FONT=Calibri] Application.ScreenUpdating = True[/FONT]


[FONT=Calibri] Application.StatusBar = False[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]  ' Inform about error[/FONT]


[FONT=Calibri]  If Err Then[/FONT]


[FONT=Calibri]    MsgBoxErr.Description, vbCritical, "Error!"[/FONT]


[FONT=Calibri]  Else[/FONT]


[FONT=Calibri]    ' Put updatinginfo in the comment of TextBox54[/FONT]


[FONT=Calibri]    If Target.CommentIs Nothing Then Target.AddComment[/FONT]


[FONT=Calibri]    WithTarget.Comment[/FONT]


[FONT=Calibri]      .Visible = True[/FONT]


[FONT=Calibri]      .TextText:="[Updated " & j & " workbook(s) on " &Now & "]" & vbLf & sSynchronized[/FONT]


[FONT=Calibri]      .Shape.TextFrame.AutoSize= True[/FONT]


[FONT=Calibri]     .Shape.TextFrame.AutoSize = False[/FONT]


[FONT=Calibri]    End With[/FONT]


[FONT=Calibri]  End If[/FONT]


[FONT=Calibri] [/FONT]


[FONT=Calibri]End Sub[/FONT]








 

NoSparks

Well-known Member
Writing textbox54 to the sheet is the same as loading textbox53 except
for 53 the textbox equals the sheet cell and for 54 the sheet cell equals the textbox.
 

NoSparks

Well-known Member
Look at the code in the user form that you are using to load the cell value into textbox53.
 

Patriot2879

Well-known Member
Hi I have tried the below but I get an error on the textbox54 line
Code:
Sub find_date_area()
  If ComboBox1 = "" Or ComboBox1.ListIndex = -1 Then Exit Sub
  If ComboBox2 = "" Or ComboBox2.ListIndex = -1 Then Exit Sub
  Dim wRow As Long, wCol As Long
  wRow = ComboBox2.ListIndex + 2
  wCol = ComboBox1.ListIndex + 2
  TextBox53 = Sheets("Data").Cells(wRow, wCol)
  TextBox54 = Sheets("TextBox54").Cells(wRow, wCol)
End Sub
 

Patriot2879

Well-known Member
how do I do the minus on this as well because once I enter a number in textbox54 this deducts from textbox53 and updates the correct cell in the 'Data' sheet, by cross referencing combobox1 and combobox2, hope you can help.
 

Some videos you may like

This Week's Hot Topics

Top