VBA: Insert value based on condition in other cell

C

Corne89

New Member
Joined
Apr 21, 2021
Messages
15
Office Version
  1. 2016
Platform
  1. Windows
VBA Jira Auswertung.xlsm
AB
1NameStorypoints
2Sprint 0810
3Sprint 0820
4
5
Tabelle1


VBA Jira Auswertung.xlsm
ABCDEFGHI
1NameStorypointsKosten
2Sprint 050
3Sprint 060
4Sprint 070
5Sprint 080
6
7
8
Auswertung
Cell Formulas
RangeFormula
C2:C5C2=B2*81


Hello guys,
i have a question regarding VBA. I want to, based on my finding from my macro, copy the sum of the storypoints of the sprint from sheet "Tabelle1" to sheet "Auswertung". Thus in my example, if something is found for Sprint 08, and the sum is calculated, this sum for Sprint 08 should be copied to sheet "Auswertung" (Thus sum=30 should be copied) to the cell in column B where cell in A has name "Sprint 08". THerefore in cell B5 the sum should be entered, because A5 has "Sprint 08".

However I didn't figure it out yet how to write that in VBA. Could you please help me out here?
Thank you!

Below you can also find my current VBA code:


Private Sub CommandButton2_Click()
'Read Value from Textbox
TxTbx = TextBox1.Text
'Value from Textbox is stored in cell
Worksheets("Auswertung").Range("Z4").Value = Me.TextBox1
Tabelle1.Select


'Check if Textbox Value is found on other sheet
'Declare Variables
Dim sumRange As Range
Dim Fund As Range
Dim criteriaRange As Range
Dim criteria As String
Set sumRange = Range("B2:B11")
Set criteriaRange = Range("A2:A11")

criteria = Worksheets("Auswertung").Range("Z4").Value
Sheets("Tabelle1").Select

Set Fund = Range("A:A").Find(Worksheets("Auswertung").Range("Z4"))
If Not Fund Is Nothing Then
'Save SumIfs Value in Cell
Range("J4") = WorksheetFunction.SumIfs(sumRange, criteriaRange, criteria)
Range("J4").Copy

Else
MsgBox Prompt:="Ihr Suchbegriff " & Sheets("Auswertung").Range("Z4") & " existiert nicht im Sheet Tabelle1. Bitte prüfen Sie Ihre Eingabe!"
Sheets("Tabelle1").Range("J4").ClearContents



End If





'Range("J4").ClearContents
'Worksheets("Auswertung").Range("Z4").ClearContents

'Closing of UserForm
Unload Sprinteingabe
End Sub
 

Excel Facts

Enter current date or time
Ctrl+: enters current time. Ctrl+; enters current date. Use Ctrl+: Ctrl+; Enter for current date & time.
Sort by date Sort by votes
Try:
VBA Code: 
Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v As Variant, i As Long, fnd As Range, total As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Auswertung")
    v = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp))
    For i = LBound(v) To UBound(v)
        If Not IsError(Application.Match(v(i, 1), srcWS.Range("A:A"), 0)) Then
            With srcWS
                .Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
                total = WorksheetFunction.Sum(.Range("B2", .Range("B" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible))
                desWS.Range("B" & i + 1) = total
            End With
        Else
            MsgBox Prompt:="Ihr Suchbegriff " & Sheets("Auswertung").Range("Z4") & " existiert nicht im Sheet Tabelle1. Bitte prüfen Sie Ihre Eingabe!"
        End If
    Next i
    srcWS.Range("A1").AutoFilter
    Unload Sprinteingabe
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try:
VBA Code: 
Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v As Variant, i As Long, fnd As Range, total As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Auswertung")
    v = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp))
    For i = LBound(v) To UBound(v)
        If Not IsError(Application.Match(v(i, 1), srcWS.Range("A:A"), 0)) Then
            With srcWS
                .Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
                total = WorksheetFunction.Sum(.Range("B2", .Range("B" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible))
                desWS.Range("B" & i + 1) = total
            End With
        Else
            MsgBox Prompt:="Ihr Suchbegriff " & Sheets("Auswertung").Range("Z4") & " existiert nicht im Sheet Tabelle1. Bitte prüfen Sie Ihre Eingabe!"
        End If
    Next i
    srcWS.Range("A1").AutoFilter
    Unload Sprinteingabe
    Application.ScreenUpdating = True
End Sub
Click to expand...
Thanks for your help, it is working. However the msgbox is showing up even though values are found in Sheet1 and are matching with the one on "Auswertung". Do you know what might be the problem here? Thanks for your help!
 
Upvote 0
I made a minor change to the msgbox. It is working properly for me using the data you posted. Are you using the macro in a different file? If so, please use the XL2BB add in (icon in the menu at top) to attach screenshots (not a pictures) of the two actual sheets.
VBA Code: 
Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, v As Variant, i As Long, fnd As Range, total As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Auswertung")
    v = desWS.Range("A2", desWS.Range("A" & Rows.Count).End(xlUp))
    For i = LBound(v) To UBound(v)
        If Not IsError(Application.Match(v(i, 1), srcWS.Range("A:A"), 0)) Then
            With srcWS
                .Range("A1").CurrentRegion.AutoFilter 1, v(i, 1)
                total = WorksheetFunction.Sum(.Range("B2", .Range("B" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible))
                desWS.Range("B" & i + 1) = total
            End With
        Else
            MsgBox ("Ihr Suchbegriff " & v(i, 1) & " existiert nicht im Sheet Tabelle1. Bitte prüfen Sie Ihre Eingabe!")
        End If
    Next i
    srcWS.Range("A1").AutoFilter
    Unload Sprinteingabe
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
Here are the sheets again, but i didnt modify anything or using a different file:
VBA Jira Auswertung.xlsm
ABCD
1NameStorypointsKosten
2Sprint 050
3Sprint 061169396
4Sprint 075405
5Sprint 08302430
6
7
Auswertung
Cell Formulas
RangeFormula
C2:C5C2=B2*81


VBA Jira Auswertung.xlsm
ABC
1NameStorypoints
2Sprint 0810
3Sprint 0820
4Sprint 075
5Sprint 065
6Sprint 06111
7Sprint 060
8Sprint 013
9
10
Tabelle1


I think the error is showing up, because in the for clause it runs through all the entries in the Sheet "Auswertung". If one Sprint which is listed on "Auswertung" and not on "Tabelle1" the error comes up (for me its with Sprint 05, because this one is not listed in Tabelle1).
This is also my mistake for not being clear enough: I want to enter a Sprint Name in the textfield/textbox (like Sprint 05) and for this value "Tabelle1" should be searched for and the found sum should then be copied to "Auswertung" and not for all the values. Thats why i was also referencing to the textbox value in my code:


1680594582112.png


Private Sub CommandButton2_Click()
'Read Value from Textbox
TxTbx = TextBox1.Text
'Value from Textbox is stored in cell
Worksheets("Auswertung").Range("Z4").Value = Me.TextBox1
Tabelle1.Select


'Check if Textbox Value is found on other sheet
'Declare Variables
Dim sumRange As Range
Dim Fund As Range
Dim criteriaRange As Range
Dim criteria As String
Set sumRange = Range("B2:B11")
Set criteriaRange = Range("A2:A11")

criteria = Worksheets("Auswertung").Range("Z4").Value
Sheets("Tabelle1").Select

Set Fund = Range("A:A").Find(Worksheets("Auswertung").Range("Z4"))
If Not Fund Is Nothing Then
'Save SumIfs Value in Cell
Range("J4") = WorksheetFunction.SumIfs(sumRange, criteriaRange, criteria)
Range("J4").Copy

Else
MsgBox Prompt:="Ihr Suchbegriff " & Sheets("Auswertung").Range("Z4") & " existiert nicht im Sheet Tabelle1. Bitte prüfen Sie Ihre Eingabe!"
Sheets("Tabelle1").Range("J4").ClearContents

End If

'Range("J4").ClearContents
'Worksheets("Auswertung").Range("Z4").ClearContents

'Closing of UserForm
Unload Sprinteingabe
End Sub


Is it possible that you could help me changing your VBA code, so that only the textbox value is being searched for?

Sorry for the misunderstanding!
 
Upvote 0
Try:
VBA Code: 
Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, total As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Auswertung")
    If Not IsError(Application.Match(Me.TextBox1.Value, srcWS.Range("A:A"), 0)) Then
        With srcWS
            .Range("A1").CurrentRegion.AutoFilter 1, Me.TextBox1.Value
            total = WorksheetFunction.Sum(.Range("B2", .Range("B" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible))
            desWS.Range("B" & i + 1) = total
        End With
    Else
        MsgBox ("Ihr Suchbegriff " & Me.TextBox1.Value & " existiert nicht im Sheet Tabelle1. Bitte prüfen Sie Ihre Eingabe!")
    End If
    srcWS.Range("A1").AutoFilter
    Unload Sprinteingabe
    Application.ScreenUpdating = True
End Sub
 
Upvote 0
mumps said:
Try:
VBA Code: 
Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, total As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Auswertung")
    If Not IsError(Application.Match(Me.TextBox1.Value, srcWS.Range("A:A"), 0)) Then
        With srcWS
            .Range("A1").CurrentRegion.AutoFilter 1, Me.TextBox1.Value
            total = WorksheetFunction.Sum(.Range("B2", .Range("B" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible))
            desWS.Range("B" & i + 1) = total
        End With
    Else
        MsgBox ("Ihr Suchbegriff " & Me.TextBox1.Value & " existiert nicht im Sheet Tabelle1. Bitte prüfen Sie Ihre Eingabe!")
    End If
    srcWS.Range("A1").AutoFilter
    Unload Sprinteingabe
    Application.ScreenUpdating = True
End Sub
Click to expand...
Hello,
this is working but now my column header is replaced by the sum found for the sprint:
VBA Jira Auswertung.xlsm
ABCD
1Name30Kosten
2Sprint 050
3Sprint 060
4Sprint 070
5Sprint 080
6
7
Auswertung
Cell Formulas
RangeFormula
C2:C5C2=B2*81


Do you know how to fix this?
 
Upvote 0
Try:
VBA Code: 
Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, total As Long, x As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Auswertung")
    If Not IsError(Application.Match(Me.TextBox1.Value, srcWS.Range("A:A"), 0)) Then
        x = Application.Match(Me.TextBox1.Value, desWS.Range("A:A"), 0)
        With srcWS
            .Range("A1").CurrentRegion.AutoFilter 1, Me.TextBox1.Value
            total = WorksheetFunction.Sum(.Range("B2", .Range("B" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible))
            desWS.Range("B" & x) = total
        End With
    Else
        MsgBox ("Ihr Suchbegriff " & Me.TextBox1.Value & " existiert nicht im Sheet Tabelle1. Bitte prüfen Sie Ihre Eingabe!")
    End If
    srcWS.Range("A1").AutoFilter
    Unload Sprinteingabe
    Application.ScreenUpdating = True
End Sub
 
Upvote 1
Solution
mumps said:
Try:
VBA Code: 
Private Sub CommandButton2_Click()
    Application.ScreenUpdating = False
    Dim srcWS As Worksheet, desWS As Worksheet, total As Long, x As Long
    Set srcWS = Sheets("Sheet1")
    Set desWS = Sheets("Auswertung")
    If Not IsError(Application.Match(Me.TextBox1.Value, srcWS.Range("A:A"), 0)) Then
        x = Application.Match(Me.TextBox1.Value, desWS.Range("A:A"), 0)
        With srcWS
            .Range("A1").CurrentRegion.AutoFilter 1, Me.TextBox1.Value
            total = WorksheetFunction.Sum(.Range("B2", .Range("B" & .Rows.Count).End(xlUp)).SpecialCells(xlCellTypeVisible))
            desWS.Range("B" & x) = total
        End With
    Else
        MsgBox ("Ihr Suchbegriff " & Me.TextBox1.Value & " existiert nicht im Sheet Tabelle1. Bitte prüfen Sie Ihre Eingabe!")
    End If
    srcWS.Range("A1").AutoFilter
    Unload Sprinteingabe
    Application.ScreenUpdating = True
End Sub
Click to expand...
Thank you very much for your help! It worked really fine :)
 
Upvote 0
You must log in or register to reply here.

Similar threads

Q
  • Question
Automatically insert new rows with predefined values
Replies
1
Views
588
quattroformatee
Q
S
  • Solved
VBA: Copy values which met condition, add them up and copy them to other sheet
Replies
2
Views
311
sharack
S
A
  • Question
How to Automatically Insert Rows based on Count Values
Replies
2
Views
457
andyka
A
J
  • Question
Inserting picture into cell via VBA
Replies
2
Views
428
Joek88
J
VinceF
  • Solved
VBA to Copy paste value based on value in cell
Replies
4
Views
319
VinceF
VinceF

Forum statistics

Threads
1,215,201
Messages
6,123,621
Members
449,109
Latest member
Sebas8956

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