Printable View
I want to add a function to my below vba.
If the value of D3 and D4 of Test Sheet is matches with column C & D of Result sheet then, display a message “You are already submitted the test paper and you have secured (D3 and D4 of Test sheet match with column E of Result Sheet) marks”.
Please check the attached file.
Thanks in advance...........
Hello Abdul
I probably have not understood exactly what you want.
But you may be able to adapt the following macros to exactly what you want
The basic coding idea:
In the Function , in section '1a) we check if the student name is present in the Results worksheet. If it is not present, then we don't need to go any further, so we Exit Function
In Rem 2 we effectively are looping down the results data and when we get a match we add the obtained marks to a string variable.
If you run the Test Calling routines on your test data ( https://excelfox.com/forum/showthrea...5233#post15233 ) , then you will get this message:
https://imgur.com/22nSRTj http://i.imgur.com/22nSRTj.jpg
https://i.imgur.com/22nSRTj.jpg
Alan
Code:Sub TestByNme()
Call CheckIfDoneItBefore("Rizwana")
End Sub
Sub TestByNmefromRange()
Call CheckIfDoneItBefore(Worksheets("test").Range("D2").Value2)
End Sub
Public Function CheckIfDoneItBefore(ByVal StdntNme As String)
Rem 1 Worksheets info
Dim wsTst As Worksheet: Set wsTst = Worksheets("Test")
Dim RegNo As String, Cls As String
Let RegNo = wsTst.Range("D3").Value2: Let Cls = wsTst.Range("D4").Value2
Dim WsRst As Worksheet: Set WsRst = Worksheets("Result")
Dim Lr As Long: Let Lr = WsRst.Range("A" & WsRst.Rows.Count & "").End(xlUp).Row ' https://excelfox.com/forum/showthread.php/2364-Delete-rows-based-on-match-criteria-in-two-excel-files-or-single-Excel-File?p=11467&viewfull=1#post11467
'1a) Names Present ( If the name of the student is not present then we don't need to go further
Dim arrNms() As Variant: Let arrNms() = WsRst.Range("B1:B" & Lr & "").Value2
If IsError(Application.Match(StdntNme, arrNms(), 0)) Then Exit Function ' If Application.Match does not find a match then it willl not error but it will return a VBA error string, which we can test for
'1b) Reg. No. Class Ob Marks
Dim arrRgNm() As Variant, arrCls() As Variant, arrMks() As Variant
Let arrRgNm() = WsRst.Range("C1:C" & Lr & "").Value2: Let arrCls() = WsRst.Range("D1:D" & Lr & "").Value2: Let arrMks() = WsRst.Range("E1:E" & Lr & "").Value2
Rem 2 Make a string of all the marks so far
Dim Cnt As Long, MsgCnt As String
For Cnt = 3 To Lr
If arrNms(Cnt, 1) = StdntNme And arrRgNm(Cnt, 1) = RegNo And arrCls(Cnt, 1) = Cls Then ' we have a match
Let MsgCnt = MsgCnt & arrMks(Cnt, 1) & vbCr & vbLf
Else
End If
Next Cnt
Rem 3 output
MsgBox prompt:="You are already submitted the test paper and you have secured" & vbCr & vbLf & MsgCnt
End Function
Thanks for your quick response, First of all please forgive. I think it is better to explain what i want instead of VBA. Sorry for that.Quote:
Originally Posted by DocAElstein
My goal is
1) Save the data from Test Sheet to Result Sheet.
2) Before saving the data I want to display a message "Do you want to save your Result, If once submitted can't be edited", vbYesNo + vbQuestion + vbDefaultButton2, "Save Result")
If Yes then save the data and display message as "Your Result is submitted successfully. You have secured Total Marks is " & Sheets("Test").Range("J4").Value
If No. display a message "Your Data not saved, you can make correction if you want then submit again"
3) If Reg. No. already saved in column C of the Result sheet is same as Reg. No. D3 of the Test sheet, then I want to alert message as "Register Number " & FindWhat & " is already submitted Test at " & Sheets("Test").Range("J6").Value & ". It can't be edited or modified. You have already secured " & Sheets("Test").Range("J5").Value & " marks."
Then back to Test Sheet.
Please check my New attached Sheet. I think my VBA code in this sheet is not properly aligned.
Hello Abdul
:confused: I don’t think I really understand what help it is that you are asking for now?
:confused:Quote:
Originally Posted by Abdul
I don’t understand what are you trying to say?
Your coding is a bit untidy. But that is personal choice. You can choose how you want to write your code
This is yours
This would be mine ( one small note: you had one obvious error Answer instead of Answer2 )Code:Sub TestPaper()
Dim FoundCell As Range
Dim FindWhat As String
FindWhat = Worksheets("Test").Range("D3").Value
Set FoundCell = Worksheets("Result").Range("C:C").Find(What:=FindWhat, LookAt:=xlWhole)
If Not FoundCell Is Nothing Then
MsgBox "Register Number " & FindWhat & " is already submitted Test at " & Sheets("Test").Range("J6").Value & ". It can't be edited or modified. You have already secured " & Sheets("Test").Range("J5").Value & " marks."
Exit Sub
End If
Dim x As Long
Dim y As Worksheet
Set y = Sheets("Result")
Dim Answer2 As VbMsgBoxResult
Answer2 = MsgBox("Do you want to save your Result, If once submitted can't be edited", vbYesNo + vbQuestion + vbDefaultButton2, "Save Result")
If Answer = vbYes Then
Else
x = Sheets("Result").Range("B" & Rows.Count).End(xlUp).Row
With y
Sheets("Test").Range("D2:D4").Copy
.Range("B" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
.Cells(x + 1, 6).Value = Sheets("Test").Range("J2").Value
.Cells(x + 1, 5).Value = Sheets("Test").Range("J4").Value
Sheets("Test").Range("L4:AZ4").Copy
.Range("G" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets("Test").Range("L5:AZ5").Copy
.Range("Q" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
With Sheets("Result").Range("A2:Z100" & x)
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Sheets("Result").Range("A3:A" & x + 1)
.Formula = "=Row() - 2"
.Value = .Value
With Sheets("Result").Range("A2:Z" & x + 1)
.BorderAround xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
End With
End With
MsgBox "Your Result is submitted successfully. You have secured Total Marks is " & Sheets("Test").Range("J4").Value
ActiveWorkbook.Save
'MsgBox "Your Data not saved, you can make correction if you want then submit again"
Exit Sub
End If
End Sub
Note: I have not full tested or checked your coding because I do not understand what you want.Code:Option Explicit
Sub TestPaper()
Dim FoundCell As Range
Dim FindWhat As String
Let FindWhat = Worksheets("Test").Range("D3").Value
Set FoundCell = Worksheets("Result").Range("C:C").Find(What:=FindWhat, LookAt:=xlWhole)
If Not FoundCell Is Nothing Then
MsgBox "Register Number " & FindWhat & " is already submitted Test at " & Sheets("Test").Range("J6").Value & ". It can't be edited or modified. You have already secured " & Sheets("Test").Range("J5").Value & " marks."
Exit Sub
Else
End If
Dim x As Long
Dim y As Worksheet
Set y = Sheets("Result")
Dim Answer2 As VbMsgBoxResult
Let Answer2 = MsgBox("Do you want to save your Result, If once submitted can't be edited", vbYesNo + vbQuestion + vbDefaultButton2, "Save Result")
If Answer2 = vbYes Then
Else
Let x = Sheets("Result").Range("B" & Rows.Count).End(xlUp).Row
With y
Sheets("Test").Range("D2:D4").Copy
.Range("B" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
.Cells(x + 1, 6).Value = Sheets("Test").Range("J2").Value
.Cells(x + 1, 5).Value = Sheets("Test").Range("J4").Value
Sheets("Test").Range("L4:AZ4").Copy
.Range("G" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets("Test").Range("L5:AZ5").Copy
.Range("Q" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
End With
With Sheets("Result").Range("A2:Z100" & x)
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Sheets("Result").Range("A3:A" & x + 1)
.Formula = "=Row() - 2"
.Value = .Value
End With
With Sheets("Result").Range("A2:Z" & x + 1)
.BorderAround xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
MsgBox "Your Result is submitted successfully. You have secured Total Marks is " & Sheets("Test").Range("J4").Value
ActiveWorkbook.Save
'MsgBox "Your Data not saved, you can make correction if you want then submit again"
Exit Sub
End If
End Sub
The test data you gave does not fully test the coding because with your test data you are in situation …..3) If Reg. No. already saved in column C of the Result sheet is same as Reg. No. D3 of the Test sheet, then I want to alert message as "Register Number " & FindWhat & " is already submitted Test at " & Sheets("Test").Range("J6").Value & ". It can't be edited or modified. You have already secured " & Sheets("Test").Range("J5").Value & " marks."……
If you want any more help, then I think you will need to explain better what help you want.
Alan
Once again thanks for you guidance and your patience. Your suggestion "one small note: you had one obvious error Answer instead of Answer2" this has helped me to solve my problem.Quote:
Originally Posted by DocAElstein
Thanks once again Alan Sir..........
If you are interested check my file..
Hello Abdul
You can choose to make it compulsory to define all variables. This means you would then be forced to Dim all variables
If you choose this option, then sometimes you will see such simple problems immediately when you try to run your macro
In your case, Answer was seen by VBA as a variable that was not declared explicitly, ( - I mean it was not Dimed like Dim Answer As …… )
If, in your original macro, you had Option Explicit at the top of your code module, then , when you tried to run your macro, you would have been warned by VBA of your small error:
http://i.imgur.com/yn4q13F.jpg
https://i.imgur.com/yn4q13F.jpg
It is just personal preference. You can choose. Most people prefer to include Option Explicit, because it is helpful to see small errors
Alan
Code:Option Explicit ' I choose to define all my variables explicitly
Sub TestPaper()
Dim FoundCell As Range
Dim FindWhat As String
FindWhat = Worksheets("Test").Range("D3").Value
Set FoundCell = Worksheets("Result").Range("C:C").Find(What:=FindWhat, LookAt:=xlWhole)
If Not FoundCell Is Nothing Then
MsgBox "Register Number " & FindWhat & " is already submitted Test at " & Sheets("Test").Range("J6").Value & ". It can't be edited or modified. You have already secured " & Sheets("Test").Range("J5").Value & " marks."
Exit Sub
End If
Dim x As Long
Dim y As Worksheet
Set y = Sheets("Result")
Dim Answer2 As VbMsgBoxResult
Answer2 = MsgBox("Do you want to save your Result, If once submitted can't be edited", vbYesNo + vbQuestion + vbDefaultButton2, "Save Result")
If Answer = vbYes Then
Else
x = Sheets("Result").Range("B" & Rows.Count).End(xlUp).Row
With y
Sheets("Test").Range("D2:D4").Copy
.Range("B" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats, Transpose:=True
.Cells(x + 1, 6).Value = Sheets("Test").Range("J2").Value
.Cells(x + 1, 5).Value = Sheets("Test").Range("J4").Value
Sheets("Test").Range("L4:AZ4").Copy
.Range("G" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
Sheets("Test").Range("L5:AZ5").Copy
.Range("Q" & x + 1).PasteSpecial Paste:=xlPasteValuesAndNumberFormats
With Sheets("Result").Range("A2:Z100" & x)
.Borders(xlEdgeLeft).LineStyle = xlNone
.Borders(xlEdgeRight).LineStyle = xlNone
.Borders(xlEdgeTop).LineStyle = xlNone
.Borders(xlEdgeBottom).LineStyle = xlNone
.Borders(xlInsideVertical).LineStyle = xlNone
.Borders(xlInsideHorizontal).LineStyle = xlNone
End With
With Sheets("Result").Range("A3:A" & x + 1)
.Formula = "=Row() - 2"
.Value = .Value
With Sheets("Result").Range("A2:Z" & x + 1)
.BorderAround xlContinuous
.Borders(xlInsideHorizontal).LineStyle = xlContinuous
.Borders(xlInsideVertical).LineStyle = xlContinuous
End With
End With
End With
MsgBox "Your Result is submitted successfully. You have secured Total Marks is " & Sheets("Test").Range("J4").Value
ActiveWorkbook.Save
'MsgBox "Your Data not saved, you can make correction if you want then submit again"
Exit Sub
End If
End Sub
Hello Alan Sir,Quote:
Originally Posted by DocAElstein
once again lot of thanks for you guidance.