Display a message if already saved data

**Abdul** · 01-24-2021, 04:20 PM

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...........

**DocAElstein** · 01-24-2021, 08:12 PM

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

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

**Abdul** · 01-25-2021, 11:33 PM

Originally Posted by DocAElstein

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

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.

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.

**DocAElstein** · 01-26-2021, 02:29 AM

Hello Abdul

I don’t think I really understand what help it is that you are asking for now?

Originally Posted by Abdul

... I think my VBA code in this sheet is not properly aligned.

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

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

This would be mine ( one small note: you had one obvious error Answer instead of Answer2 )

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

Note: I have not full tested or checked your coding because I do not understand what you want.
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

**Abdul** · 01-26-2021, 11:13 AM

Originally Posted by DocAElstein

This would be mine ( one small note: you had one obvious error Answer instead of Answer2 )

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.
Thanks once again Alan Sir..........
If you are interested check my file..

**DocAElstein** · 01-26-2021, 02:04 PM

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

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