Update cell after update from userform

P

Patriot2879

Well-known Member
Joined
Feb 1, 2018
Messages
1,259
Office Version
  1. 2010
Platform
  1. Windows
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]









 
Sort by date Sort by votes

Excel Facts

Can a formula spear through sheets?
Use =SUM(January:December!E7) to sum E7 on all of the sheets from January through December
For example when somebody enters a number in textbox54 this gets deducted from textbox53 and gets updates in the 'data' sheet.
 
Upvote 0
Patriot2879 said:
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.
Click to expand...

Hi
try following

Make a BACKUP of your workbook & add following codes to your forms code page

Rich (BB code): 
Dim wRow As Long, wCol As Long
Dim wsData As Worksheet


Private Sub TextBox54_Change()
    Dim Availability As Integer, Book As Integer
    
    If Not Me.Visible Or Len(Me.TextBox54) = 0 Then Exit Sub
    
    Availability = Val(Me.TextBox53.Value)
    Book = Val(Me.TextBox54.Value)
    
    If Availability > 0 Then
        If Book > 0 And Book <= Availability Then
            Availability = Availability - Book
            wsData.Cells(wRow, wCol).Value = Availability
            Me.TextBox53.Text = Availability
            RefreshTable
        End If
    End If
End Sub


Sub RefreshTable()
    Dim r As Long, c As Long
    Dim txtbox As Integer
    r = 2
    c = 2
    For txtbox = 34 To 122
     Select Case txtbox
     Case 51 To 54
     
     Case Else
        Me.Controls("TextBox" & txtbox).Text = wsData.Cells(r, c).Text
        c = c + 1
        If c > 18 Then c = 2: r = r + 1
     End Select
        
    Next txtbox
End Sub


Sub find_date_area()
  If ComboBox1.ListIndex = -1 Then Exit Sub
  If ComboBox2.ListIndex = -1 Then Exit Sub
  wRow = ComboBox2.ListIndex + 2
  wCol = ComboBox1.ListIndex + 2
  TextBox53 = wsData.Cells(wRow, wCol).Text
End Sub

Note:
1 - Ensure that you DELETE any existing codes with the same name
2 - Ensure that the variables shown in BOLD are placed at the very TOP of the forms code page OUTSIDE any procedure

Replace your UserForm_Initialize code with the following

Rich (BB code): 
Private Sub UserForm_Initialize()
Dim DateStr As String


Set wsData = ThisWorkbook.Worksheets("Data")


With wsData
Dim ResultStr As String
DateStr = .Range("B1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox1.MultiLine = vbTrue
Me.TextBox1.Text = ResultStr


DateStr = .Range("C1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox2.MultiLine = vbTrue
Me.TextBox2.Text = ResultStr


DateStr = .Range("D1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox3.MultiLine = vbTrue
Me.TextBox3.Text = ResultStr


DateStr = .Range("E1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox4.MultiLine = vbTrue
Me.TextBox4.Text = ResultStr


DateStr = .Range("F1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox5.MultiLine = vbTrue
Me.TextBox5.Text = ResultStr


DateStr = .Range("G1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox6.MultiLine = vbTrue
Me.TextBox6.Text = ResultStr


DateStr = .Range("H1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox7.MultiLine = vbTrue
Me.TextBox7.Text = ResultStr


DateStr = .Range("I1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox8.MultiLine = vbTrue
Me.TextBox8.Text = ResultStr


DateStr = .Range("J1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox9.MultiLine = vbTrue
Me.TextBox9.Text = ResultStr


DateStr = .Range("K1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox10.MultiLine = vbTrue
Me.TextBox10.Text = ResultStr


DateStr = .Range("L1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox11.MultiLine = vbTrue
Me.TextBox11.Text = ResultStr


DateStr = .Range("M1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox13.MultiLine = vbTrue
Me.TextBox13.Text = ResultStr


DateStr = .Range("N1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox14.MultiLine = vbTrue
Me.TextBox14.Text = ResultStr


DateStr = .Range("O1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox15.MultiLine = vbTrue
Me.TextBox15.Text = ResultStr


DateStr = .Range("P1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox16.MultiLine = vbTrue
Me.TextBox16.Text = ResultStr


DateStr = .Range("Q1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox17.MultiLine = vbTrue
Me.TextBox17.Text = ResultStr


DateStr = .Range("R1").Text
ResultStr = Right(DateStr, 1)
For i = Len(DateStr) - 1 To 1 Step -1
    ResultStr = ResultStr & vbCrLf & Mid(DateStr, i, 1)
Next i
Me.TextBox18.MultiLine = vbTrue
Me.TextBox18.Text = ResultStr




RefreshTable


ComboBox1.RowSource = ""
ComboBox1.List = Application.Transpose(.Range("B1:R1").Value)
ComboBox2.RowSource = ""
ComboBox2.List = .Range("A2:R" & .Range("A" & .Rows.Count).End(xlUp).Row).Value
End With




End Sub


Hopefully will do what you want but adjust as required.

Dave
 
Upvote 0
Hello good morning, I have amended the code as advised thank you for this, but I get an error on the line below, hope you can help.

Code: 
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/COLOR][/SIZE][/FONT][FONT=Calibri][SIZE=3][COLOR=#000000]Sub find_date_area()[/COLOR][/SIZE][/FONT]
[FONT=Times New Roman][SIZE=3][COLOR=#000000][/CO[/COLOR][/SIZE][/FONT]DE]
 
Upvote 0
Patriot2879 said:
Hi please see below my test sheet, hopefully I did what you advised correctly, and if you can advise please where I have gone wrong.
https://www.dropbox.com/s/kpnugulubcbgbj2/Capacitytest.xlsm?dl=0
Click to expand...

In my post I had this line

1 - Ensure that you DELETE any existing codes with the same name
Click to expand...

which you have not followed

You have two codes that need to be deleted

Code: 
Private Sub UserForm_Initialize()

make sure you DELETE the OLD version the new one contains this line at the start

Code: 
Set wsData = ThisWorkbook.Worksheets("Data")

The UserForm_Initialize code that contains this is the one you need to keep

The code below that looks like this needs to be DELETED

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)
End Sub

Let me know if all working ok & will show you how you can replace all those textbox change event codes with just one.

Dave
 
Upvote 0
Hi it working I didn't delete all what you advised, thisIs great thank you, please can you advise how when I put thenumber in I can clear textbox54? After its done its update
 
Upvote 0
this is brill thank you, its amazing, I can put all the textboxes into one? wow that would be amazing as it is massive at the moment
 
Upvote 0
You must log in or register to reply here.

Similar threads

K
  • Question Question
I was try to load data To List Box And Transfer data to Sheet2.... (Not work this userform)
Replies
4
Views
237
krunal123
K
I
  • Question Question
Worksheet value is updated only after userform is closed
2
Replies
13
Views
513
ipbr21054
I
A
  • Question Question
VBA for setting up the printing pages per sheet
Replies
0
Views
603
Aurum1
A
wsnyder
  • Question Question
Update Pivot Filters from Cell Values
Replies
1
Views
773
DanteAmor
DanteAmor
P
  • Question Question
update listbox from 2 different sheets
2
Replies
11
Views
746
Patriot2879
P

Forum statistics

Threads
1,224,822
Messages
6,181,165
Members
453,021
Latest member
Justyna P

Share this page

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top