VBA: Am I double-calling a Sub given nested If statements? Or other inefficiencies?

[SirGruffles]

Hello,

I'm new to VBA and trying to make a custom Dashboard for a manager.
Below lies my attempt at creating a data refresh and save macro that will be tied to a button on the "Dashboard" sheet.

My main question is: Am I actually calling the RefreshData() sub twice in WriteData(), thereby making the entire process twice as long?
I know the server some of my queries are connecting to is a tad slow, so I know that's part of my issue, but I want to make sure I'm not shooting myself in the foot with my own code.

Sub RefreshData()
Dim Quer As Long
    With ThisWorkbook
        For Quer = 1 To .Connections.Count
            If .Connections(Quer).Type = xlConnectionTypeOLEDB Then
                .Connections(Quer).OLEDBConnection.BackgroundQuery = False
            End If
        Next Quer
    End With
          
ThisWorkbook.RefreshAll

End Sub
------------------------------------------------------------------------------------------------------
Sub WriteData()
Dim cell As Range
Dim cell2 As Range
Dim Daily As Object
Dim DataDate As Range
Dim answer As Integer

Set Daily = Sheets("Dashboard")
Set DataDate = Daily.Range("C4")

For Each cell In Sheets("YTD Data").Range("B8:B400")
    If cell.Value = DataDate Then
        If HasValue(Range(cell.Offset(0, 1), cell.Offset(0, 21))) Then
          answer = MsgBox("There is data saved for this date already." & vbNewLine & "Do you wish to proceed?" & vbNewLine & "Continuing will overwrite current data!", vbQuestion + vbYesNo)
            If answer = vbNo Then
            MsgBox ("Refresh process cancelled.")
            Exit Sub
            Else: password = InputBox("Please enter data overwrite password.")
                If password = "GoDiegoGo" Then
                        Call RefreshData
                        Else: password = MsgBox("Your entered password is incorrect." & vbNewLine & "Now ending refresh process.", vbOKOnly, "INCORRECT PASSWORD!")
                        Exit Sub
                End If
                    End If
                        End If
                        End If
                        Next
                       
Call RefreshData
Daily.Range("C9:V9").Copy

For Each cell2 In Sheets("YTD Data").Range("B8:B400")
    If cell2.Value = DataDate Then
    cell2.Offset(0, 1).PasteSpecial xlPasteValues
        End If
    Next

Worksheets("Dashboard").Activate
Application.CutCopyMode = False
Cells(3, 6).Value = Format(Now, "mm/dd/yyyy")
Cells(4, 6).Value = Format(Now, "hh:mm ampm")
ThisWorkbook.Save

MsgBox "\o/ Praise the Sun \o/"

End Sub
------------------------------------------------------------------------------------------------------
Function HasValue(rng As Range) As Boolean
    HasValue = Not rng.Find(What:="*", LookIn:=xlValues) Is Nothing
    End Function

I appreciate any help given.
If you have the spare time to find any other inefficiencies in my code, I would be greatly appreciative.
But I understand if that is technically out of scope for this forum request.

Thank you for your time.

 

[dreid1011]

You are calling it twice if the password is correct. Or rather, as many times as you end up overwriting data plus 1 for the call after the loop. Is it necessary to refresh after each overwriting?

 

[SirGruffles]

You are calling it twice if the password is correct. Or rather, as many times as you end up overwriting data plus 1 for the call after the loop. Is it necessary to refresh after each overwriting?

There is only one instance of overwriting on this dashboard.
This VBA will be updating and saving all data at once, so no additional runs *should* need to be run.

I suppose the thought process/goal here is:

Does YTD Data have data for this date already?
If no, process normally.
If yes, Do you want to Overwrite that data?

If no, exit sub.
If yes, enter the overwrite password.

If wrong password, say so and exit sub.
If correct password, process normally.

I guess I'm asking what to put instead of the Call RefreshData within the password ifelse statement?

 

[dreid1011]

It's probably fine then if the code doesn't actually do both every time it runs. After closer inspection, it looks like it either makes it to the password entry (and exits sub regardless of correct password) or it doesn't find the date anywhere and continues after the loop.

As far as other inefficiencies, looping over the same set of data twice doesn't particularly help. There may be a better way to check for the date in the range, but I don't know it off the top of my head, I'm sorry. I will look into it though.

 

[SirGruffles]

It's probably fine then if the code doesn't actually do both every time it runs. After closer inspection, it looks like it either makes it to the password entry (and exits sub regardless of correct password) or it doesn't find the date anywhere and continues after the loop.

As far as other inefficiencies, looping over the same set of data twice doesn't particularly help. There may be a better way to check for the date in the range, but I don't know it off the top of my head, I'm sorry. I will look into it though.

Please don't apologize lol.

That being said, I've rewritten that section as seen below, and I'm about to give it a test.

For Each cell In Sheets("YTD Data").Range("B8:B400")
    If cell.Value = DataDate Then
        If HasValue(Range(cell.Offset(0, 1), cell.Offset(0, 21))) Then
          answer = MsgBox("There is data saved for this date already." & vbNewLine & "Do you wish to proceed?" & vbNewLine & "Continuing will overwrite current data!", vbQuestion + vbYesNo)
            If answer = vbNo Then
            MsgBox ("Refresh process cancelled.")
            Exit Sub
            Else: password = InputBox("Please enter data overwrite password.")
                If password <> "GoDiegoGo" Then
                password = MsgBox("Your entered password is incorrect." & vbNewLine & "Now ending refresh process.", vbOKOnly, "INCORRECT PASSWORD!")
                Exit Sub
                Else: End If
                End If
                    End If
                        End If
                        Next
                       
Call RefreshData
Daily.Range("C9:V9").Copy

 

[SirGruffles]

The above change to having password be a "not-equals to" operation was the key.
And then figuring out that I can just move the respective End If, instead of calling RefreshData again for a correct password input.
Might not be the most efficient still, but it at least runs, saves, and isn't doing the same macro twice now.
Thank you.

 

[dreid1011]

Just for kicks, this bit here can replace your first loop but put in the meaty bits for the password:

Private Sub WriteData()
Dim dataDate As Date
Dim lRow As Long
dataDate = Range("B4").Value
Range("B7:B400").AutoFilter Field:=1, Criteria1:=dataDate
lRow = Range("B" & Rows.Count).End(xlUp).Row
Range("C8:W" & lRow).SpecialCells(xlCellTypeVisible).Select
If HasValue(Range("C8:W" & lRow).SpecialCells(xlCellTypeVisible)) Then
    MsgBox "Data Present"
    Else
    MsgBox "No Data"
End If
End Sub

Function HasValue(rng As Range) As Boolean
    HasValue = Not rng.Find(What:="*", LookIn:=xlValues) Is Nothing
End Function

Though it does apply a filter to the data, you could add a line to clear the filter afterwards. Saves you from looping through it twice. Of course, if the date can be there more than once, might have to adjust the code.

 

[dreid1011]

Just for kicks, this bit here can replace your first loop but put in the meaty bits for the password:

Private Sub WriteData()
Dim dataDate As Date
Dim lRow As Long
dataDate = Range("B4").Value
Range("B7:B400").AutoFilter Field:=1, Criteria1:=dataDate
lRow = Range("B" & Rows.Count).End(xlUp).Row
Range("C8:W" & lRow).SpecialCells(xlCellTypeVisible).Select
If HasValue(Range("C8:W" & lRow).SpecialCells(xlCellTypeVisible)) Then
    MsgBox "Data Present"
    Else
    MsgBox "No Data"
End If
End Sub

Function HasValue(rng As Range) As Boolean
    HasValue = Not rng.Find(What:="*", LookIn:=xlValues) Is Nothing
End Function

Though it does apply a filter to the data, you could add a line to clear the filter afterwards. Saves you from looping through it twice. Of course, if the date can be there more than once, might have to adjust the code.

Revised to include the rest of your first loop:

Private Sub WriteData()
Dim dataDate As Date
Dim lRow As Long
Dim answer As Integer
Dim password As String
dataDate = Range("B4").Value
Range("B7:B400").AutoFilter Field:=1, Criteria1:=dataDate
lRow = Range("B" & Rows.Count).End(xlUp).Row
Range("C8:W" & lRow).SpecialCells(xlCellTypeVisible).Select
If HasValue(Range("C8:W" & lRow).SpecialCells(xlCellTypeVisible)) Then
    answer = MsgBox("There is data saved for this date already." & vbNewLine & "Do you wish to proceed?" & vbNewLine & "Continuing will overwrite current data!", vbQuestion + vbYesNo)
    If answer = vbNo Then
        MsgBox "Refresh process cancelled."
        GoTo GetOut
    Else
        password = InputBox("Please enter data overwrite password.")
        If password = "GoDiegoGo" Then
            MsgBox "Password Accepted"
        Else
            password = MsgBox("Your entered password is incorrect." & vbNewLine & "Now ending refresh process.", vbOKOnly, "INCORRECT PASSWORD!")
            GoTo GetOut
        End If
    End If
End If

'Put operational code here if password is accepted


GetOut:
Range("B7:B400").AutoFilter
End Sub

Function HasValue(rng As Range) As Boolean
    HasValue = Not rng.Find(What:="*", LookIn:=xlValues) Is Nothing
End Function

 

[dreid1011]

Revised to include the rest of your first loop:

Private Sub WriteData()
Dim dataDate As Date
Dim lRow As Long
Dim answer As Integer
Dim password As String
dataDate = Range("B4").Value
Range("B7:B400").AutoFilter Field:=1, Criteria1:=dataDate
lRow = Range("B" & Rows.Count).End(xlUp).Row
Range("C8:W" & lRow).SpecialCells(xlCellTypeVisible).Select
If HasValue(Range("C8:W" & lRow).SpecialCells(xlCellTypeVisible)) Then
    answer = MsgBox("There is data saved for this date already." & vbNewLine & "Do you wish to proceed?" & vbNewLine & "Continuing will overwrite current data!", vbQuestion + vbYesNo)
    If answer = vbNo Then
        MsgBox "Refresh process cancelled."
        GoTo GetOut
    Else
        password = InputBox("Please enter data overwrite password.")
        If password = "GoDiegoGo" Then
            MsgBox "Password Accepted"
        Else
            password = MsgBox("Your entered password is incorrect." & vbNewLine & "Now ending refresh process.", vbOKOnly, "INCORRECT PASSWORD!")
            GoTo GetOut
        End If
    End If
End If

'Put operational code here if password is accepted


GetOut:
Range("B7:B400").AutoFilter
End Sub

Function HasValue(rng As Range) As Boolean
    HasValue = Not rng.Find(What:="*", LookIn:=xlValues) Is Nothing
End Function

Minor adjustment:

Private Sub WriteData()
Dim dataDate As Range
Dim lRow As Long
Dim answer As Integer
Dim password As String
Set dataDate = Sheets("Dashboard").Range("C4")
Sheets("YTD Data").Range("B7:B400").AutoFilter Field:=1, Criteria1:=dataDate.Value
lRow = Sheets("YTD Data").Range("B" & Rows.Count).End(xlUp).Row
Sheets("YTD Data").Range("C8:W" & lRow).SpecialCells(xlCellTypeVisible).Select
If HasValue(Sheets("YTD Data").Range("C8:W" & lRow).SpecialCells(xlCellTypeVisible)) Then
    answer = MsgBox("There is data saved for this date already." & vbNewLine & "Do you wish to proceed?" & vbNewLine & "Continuing will overwrite current data!", vbQuestion + vbYesNo)
    If answer = vbNo Then
        MsgBox "Refresh process cancelled."
        GoTo GetOut
    Else
        password = InputBox("Please enter data overwrite password.")
        If password = "GoDiegoGo" Then
            MsgBox "Password Accepted"
        Else
            password = MsgBox("Your entered password is incorrect." & vbNewLine & "Now ending refresh process.", vbOKOnly, "INCORRECT PASSWORD!")
            GoTo GetOut
        End If
    End If
End If

'Put operational code here if password is accepted


GetOut:
Sheets("YTD Data").Range("B7:B400").AutoFilter
End Sub

Function HasValue(rng As Range) As Boolean
    HasValue = Not rng.Find(What:="*", LookIn:=xlValues) Is Nothing
End Function