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

Workdays for a market open Mon, Wed, Friday?
Yes! Use "0101011" for the weekend argument in NETWORKDAYS.INTL or WORKDAY.INTL. The 7 digits start on Monday. 1 means it is a weekend.
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

ExcelNewbie2020
  • Solved
VBA to replicate values to allign with the longest non empty cell in other columns
Replies
1
Views
200
Eric W
Eric W
Q
  • Question Question
Automatically insert new rows with predefined values
Replies
1
Views
731
quattroformatee
Q
E
  • Solved
Quick VBA code to Hide Rows based on Cell Value
Replies
3
Views
518
Joe4
Joe4
T
  • Question Question
Open CSV with VBA, convert to ANSI and a cell "75 %" is changed to format type percent and the value is changed to "0.75"
Replies
1
Views
348
Tanquen
T
J
  • Question Question
Automatically move cells from one sheet to another based on criteria using VBA
Replies
5
Views
761
DanteAmor
DanteAmor

Forum statistics

Threads
1,223,903
Messages
6,175,279
Members
452,630
Latest member
OdubiYouth

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