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 Dave thank you so much for getting back to me. How would I do your idea please? Shall I put my file on dropbox?

 

[dmt32]

Hi Dave thank you so much for getting back to me. How would I do your idea please? Shall I put my file on dropbox?

I will when have moment have a play & post in my dropbox if I can develop the idea

Dave

 

[Patriot2879]

Thank you Dave your help is much appreciated

 

[Patriot2879]

Hi Dave for some reason I cant message you in private I have used up all my minutes

 

[dmt32]

Hi Dave for some reason I cant message you in private I have used up all my minutes

If you are using PM & it won't let you suggests your inbox is full & needs emptying

What is it you want to know?

Dave

 

[Patriot2879]

Thanks Dave just deleted a lot of old messages so I think the pvt msg is working ok now