Update Values to an Existing Sheet from every new Sheet created by Macro

DespitePain

New Member
Joined
Aug 7, 2018
Messages
1
Hello Everyone,
As the question on the title, I want to update the values of a sheet from every new sheet that gets created by a macro I made. I made a Macro run when inserted Client Name on the inputbox that runs after you click a button. (Image 2)

When the Client Name is correct, the Macro will automatically create a sheet and name it after the Client Name and also will create a new Table for that Client (The Table Format does not change on any Client).

In that table afterwards values will be entered, like the amount of income, the date of that income, and which of the Workers took the income. Specifically in cell "I8" will be entered the amount, in "J8" the date will be entered and most importantly in "K8" the name of the Worker who took the income will be inserted, this will go on to the other income of the client "I9","J9","K9" then "I10","J10","K10" and so on (Image 3).

The Table that I created for those 4 existing sheets of Workers is as shown at Image 1, so on "A10","A12","A14" and so on the name of the clients that the worker got the income from will be pasted (hopefully). if the client name is on "A10" then the amount of income that the worker will receive will be entered automatically (hopefully again) at "C10", "D10", "E10", "F10" and "G10", Also the date when he got the income "C11", "D11", "E11", "F11" and "G11", same goes if the Worker gets income from other clients (Ex: "A12" -> "C12"=Amount, "C13"=Date, "D12" "C13", and so on) , see the Image 1.

(Keep in mind there are 5 different times a client can send incomes, that's why there are 5 columns for incomes)

Now the question is that, I need a code that will automatically:

1. Copy Paste the name of the Client to the Worker Sheet
2. Copy the amount of Income that the client gave to a Worker, into the Worker Sheet
3. Copy the Date of when that amount of Income has been received

The Macro Code I made did not work (They either ended up with a error and even fixing the error didn't do anything, or simply nothing changes on the Worker Sheet if I enter any value at the New Client Sheet).

Note: The First Sub is just the application Inputbox code and Sheet Formation, the Second Sub is the Table formation and at the end of it is the codes that I commented on purpose, because none of them worked.


If you do not understand from the code below because of the format, here are the codes shown in image:



Code:
[LEFT][COLOR=#333333][FONT=monospace] Function WorksheetExists2(WorksheetName As String, Optional wb As Workbook) As Boolean
    If WorksheetExists2(EmriKlientit) Then
        ActiveWorkbook.Sheets(EmriKlientit).Activate
    Else
        GoTo sheet:
End Function
Sub KerkimiKlientit()
    Dim EmriKlientit As String
    Dim rng As Range, cel As Range
    Dim OutPut As Integer

retry:
    
    EmriKlientit = Application.InputBox("Shkruani Emrin e Klientit", "Kerkimi")
    If Trim(EmriKlientit) <> "" Then
        With Sheets("Hyrjet").Range("B10:B200")
            Set rng = .Find(What:=EmriKlientit, _
                            After:=.Cells(.Cells.Count), _
                            LookIn:=xlValues, _
                            LookAt:=xlWhole, _
                            SearchOrder:=xlByRows, _
                            SearchDirection:=xlNext, _
                            MatchCase:=False)
            If Not rng Is Nothing Then
sheet:
                Flag = 0
                Count = ActiveWorkbook.Worksheets.Count
                    For i = 1 To Count
                        WS_Name = ActiveWorkbook.Worksheets(i).Name
                        If WS_Name = EmriKlientit Then Flag = 1
                    Next i
                        If Flag = 1 Then
                            ActiveWorkbook.Sheets(EmriKlientit).Activate
                            Exit Sub
                        Else
                            Sheets.Add(, Sheets(Sheets.Count)).Name = EmriKlientit
                            Call KrijimiTabeles(EmriKlientit)
                            Exit Sub
                        End If

            Else
                OutPut = MsgBox("Klienti nuk u gjet", vbRetryCancel + vbInformation, "Provoni Perseri")
                    If (OutPut = vbRetry) Then
                        GoTo retry:
                    ElseIf (OutPut = vbCancel) Then
                        Exit Sub
                    End If
                Exit Sub
            End If
        End With
    End If
    If userInputValue = "" Then
        OutPut = MsgBox("Rubrika e Emrit e zbrazet", vbRetryCancel + vbExclamation, "Gabim")
            If (OutPut = vbRetry) Then
                GoTo retry:
            ElseIf (OutPut = vbCancel) Then
                Exit Sub
            End If
    Else
        GoTo retry:
    End If
End Sub

Sub KrijimiTabeles(EmriKlientit As String)
'
' KrijimiTabeles Macro
'
'This was just a big line of the Table creation, not important because it works perfectly.


'And these are the codes I used, all of these did not work because they either did not update or either ended up with errors and even fixing them won't change anything, the recent code I used is the uncommented one.

Dim wsClient As Worksheet, wsMustafa As Worksheet
Dim i As Long
Dim fRow As Long, lRow As Long
Set wsClient = ActiveWorkbook.Sheets(EmriKlientit)
Set wsMustafa = ActiveWorkbook.Sheets("Mustafa")
fRow = 8
lRow = 23

For i = fRow To lRow
    If wsClient.Range("K" & i).Value = "M" Then
        wsMustafa.Range("K6").Value = wsClient.Range("K" & i).Value 'or .Formula if that's what you want
    End If
Next i
    
'Sub Formula(EmriKlientit As String, ByVal Target As Range)
    'ActiveWorkbook.Sheets(EmriKlientit).Activate
    'If Not Application.Intersect(Range("K8:K23"), Range(Target.Adress)) Is Nothing Then
    'Call Formula1
    'End If
'End Sub
'Dim LR As Long, i As Long
    'Application.ScreenUpdating = False
    'Dim Rng As Range
    'For Each Rng In Range("K8:K23")
        'Select Case Rng.Value
            'Case "M"
                'Worksheets(EmriKlientit).Range("K2").Copy
                'Worksheets("Mustafa").Range("K6").PasteSpecial Paste:=xlPasteFormulas
        'End Select
    'Next Rng
    'Application.ScreenUpdating = True
    'For Each cel In Rng
        'If cel.Value = "M" Then
            'Worksheets(EmriKlientit).Range("K2").Copy
            'Worksheets("Mustafa").Range("K6").PasteSpecial Paste:=xlPasteFormulas
        'End If
    'Next cel
            
        
'ActiveWorkbook.Sheets(EmriKlientit).Activate
    'If Not Application.Intersect(Range("K8:K23"), Range(Rng.Adress)) Is Nothing Then
        'With Sheets(EmriKlientit)
            'With .Range("K8:K23")
                'If .Text = "M" Then
                    'Worksheets(EmriKlientit).Range("K2").Copy
                    'Worksheets("Mustafa").Range("K6").PasteSpecial Paste:=xlPasteFormulas
                'End If
            'End With
        'End With
    'End If
    'Flag = 0
        'Count = ActiveWorkbook.Worksheets.Count
            'For i = 1 To Count
                'WS_Name = ActiveWorkbook.Worksheets(i).Name
                'If WS_Name = EmriKlientit Then Flag = 1
                    'Next i
                        'If Flag = 1 Then
                            'ActiveWorkbook.Sheets(EmriKlientit).Activate
                                'For Each Cell In Sheets(EmriKllientit).Range("K8:K23")
                                    'If Cell.Value = "M" Then
                                        'Range("K2").Copy
                                        'Worksheets("Mustafa").Range("K6").PasteSpecial Paste:=xlPasteFormulas
                                    'End If
                                'Next
                        'End If

End Sub
[/FONT][/COLOR][/LEFT]
 

Excel Facts

Round to nearest half hour?
Use =MROUND(A2,"0:30") to round to nearest half hour. Use =CEILING(A2,"0:30") to round to next half hour.

Forum statistics

Threads
1,215,043
Messages
6,122,825
Members
449,096
Latest member
Erald

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