Update cell after update from userform

[Patriot2879]

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?

[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]

 

[Patriot2879]

Hi I have added the file to the dropbox hopefully you can have a look please.
https://www.dropbox.com/s/roi10ux8jsstja8/Capacity2.xlsm?dl=0

 

[Patriot2879]

When the coding is in the majority of the lines are in red if that helps

 

[Patriot2879]

Hi I hope you can help? hope you can open my dropbox file

 

[NoSparks]

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.

 

[Patriot2879]

Sorry I am not following what I need to do. I need it to look in the data sheet to update

 

[NoSparks]

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

 

[Patriot2879]

Hi ok o try but how do I deduct

 

[Patriot2879]

Hi I have tried the below but I get an error on the textbox54 line

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]

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.