Expanding a Macro Already Written

[SanFelippo]

Hi,

I have gotten some new requests, and now need to know if it would be possible to add on to the Macro that was written for me in a previous post. Currently, the macro checks for the last row that has an address entered into it in column B, and then makes sure a "Type" is selected in that same row in column F. I was wondering if it would also be possible to expand this.

I would need the Macro to also check and make sure that there are selections made in columns Q, R, S, T, and U if there is an address populated in row B. Columns Q and R are cells that are manually filled in, so it would need to make sure they are not blank, while columns S, T, and U are dropdown lists, so it would need to make sure that none of those are still on the "(Select One)" option.

Would it also be possible to have the Macro call out what is missing then? For example, right now if it is missing Type, the macro calls out which row it is missing the Type in. the Column Names for Q - U are as follows:

Q: Total (Dwelling) Units
R: Multifamily Afforable Units
S: Construction Method
T: Manufactured Home Secured Property Type
U: Manufactured Home Land Property Interest

Here is the original post along with the Macro that was written to satisfy it:

To make this easier to understand, I am going to post some sample data below the question I have. I have two columns of data, one is a column with 15 rows that one would enter addresses into, and then the other is a column called type that has a drop list that contains 4 choices:

(Select One)
Type 1
Type 2
Type 3

What I am looking for is a macro I can run that will look and see if there is an address filled out in Column B, and if there is, go and look to see if a Type was chosen. If a Type was not chosen (AKA the Type is still on the choice "(Select One)", I would like a message box to appear that stating that if an address is filled out in Column B, then a corresponding Type must be chosen, If possible, could the message box also indicate which row the error occurred on?

I know this could be done with like 15 if, then statements, but I figure there has got to be an easier way to do it, so I figured I would ask. I am not looking for this to be run or coded in a Worksheet_Change(ByVal Target As Range) Sub. This will be something I attach to a button that will run it when pressed.

Any help?




So, if the situation below was present and I ran the Macro, I would get the error box popping us telling me that if cell B5 is populated with an address, cell F5 must have a Type Chosen.

Column (B) Address	Column (F) Type
123 Anywhere	Type 1
1234 Anywhere	Type 3
12345 Anywhere	Type 2
123456 Anywhere	(Select One)

<tbody>
</tbody>

*This code was written by a member named Rick, and excel MVP on this forum*

Sub CheckTypeSelected()
  Dim LastRow As Long, RowNums As String
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  RowNums = Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(LEN(B1:B#)*(F1:F#=""(Select One)""),ROW(B1:B#),"""")", "#", LastRow))))), " ", ", ")
  If Len(RowNums) Then
    MsgBox "If an address is filled out in Column B, then a corresponding Type must be chosen in Column F." & vbLf & vbLf & "These rows have no Type selected: " & RowNums
  End If
End Sub

 

[L. Howard]

Try my stab at it.
I have a problem with column F having more than one cell with a (Select One) in them. The Rick code does not "list them" as I think the code is supposed to do...? With more than one (Select One) I get an error.

Otherwise, seems to do what you want.

Howard

Option Explicit
Sub CheckTypeSelected()
Dim OneRng As Range
Dim cRng As Long
Dim myCheckF
Dim myCheckQ
Dim c As Range
Dim qMSG As String
Dim LastRow As Long, RowNums As String

  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  
  RowNums = Replace(Application.Trim(Join(Application. _
            Transpose(Evaluate(Replace("IF(LEN(B1:B#)*(F1:F#=""(Select One)""),ROW(B1:B#),"""")", "#", LastRow))))), " ", ", ")
            
 
  Set OneRng = Range("Q" & RowNums).Resize(1, 5)
        cRng = Application.WorksheetFunction.CountA(OneRng)
   
  If Len(RowNums) Then
  
    myCheckF = MsgBox("If an address is filled out in Column B, then a corresponding Type must be chosen in Column F." & vbLf & vbLf & _
            "These rows have no Type selected: " & RowNums, vbOKCancel)
          If myCheckF = vbOK Then
           'Cells(RowNums, 6) = Cells(RowNums, 6) & " Fill this Cell!"
       
    Else
    
        Exit Sub
        
  End If
      
            
  If cRng <> 5 Then
    
    OneRng.Activate
    myCheckQ = MsgBox("Col Q - to - U has at least empty cell!", vbOKCancel)
    
    If myCheckQ = vbOK Then
        
       For Each c In OneRng
          If IsEmpty(c) = True Then
          
          qMSG = c.Offset(-(RowNums - 1)).Value
          MsgBox "" & qMSG & "" & " Column row: " & RowNums & " must be filled in!"
          c.Activate
            Exit For
          End If
       Next c
        
    Else
        MsgBox "Cancel code_Q"
        Exit Sub
    End If
  End If
            
            
  End If
End Sub

 

[SanFelippo]

Hey Howard,

I am having difficulty getting this code to run. I should mention that this code isn't going to be under it's own sub. It is incorporated into a sub that has a good number of If Then statements in it, so it will only run if certain conditions are met. The original code from Rick I was able to just remove the "Subs" and just paste the code in the section it needed to be, but this one I can't seem to do that with. Any suggestions?

 

[L. Howard]

There is no way for me to know why the code doesn't run within you existing code. Does it work if you run the code by itself?

Maybe you can get away with inserting the code name in the line position of your existing code where you want mine to run. You would just inset CheckTypeSelected in your code as a single line, and when your code runs and comes to this line the focus would go to my code and run and when it is finished running my code the focus will come back to the next line of code in your macro.

Howard

 

[SanFelippo]

I see the problem actually. So the big picture is this macro is attached to a button. This button is pressed when the person filling out the excel sheet wants to go to the next tab. Once pressed, the macro will run through a pretty huge amount of code that checks for missing data, correctly entered data, etc. So basically, the code I am trying to work into it now (that you have beautifully written btw), follows an "Else" statement. The very last piece of the macro is simply

Else
    Sheets(1 + (ActiveSheet.Index Mod Sheets.Count)).Select
End If
End If
End If
.
.
.
.
.
End Sub

So, the piece you wrote is going to go before that last bit, meaning that excel is looking for an "If" statement that follows the "Else." This makes it difficult to simply inset the CheckTypeSelected.

I see the Rick code worked when I just took off the "sub" pieces because it starts with an "If."

 

[L. Howard]

I'm not sure I can "fix it" but how about posting your entire code.

At the point in your code where you want my code to run insert > '// code goes here

I can at least take a look at it.

Howard

 

[SanFelippo]

This may be kind of long an obnoxious, so if you see any way to shorten what I already have here feel free to suggest it. Here is the entire code. This is currently what I have, AKA it includes the Rick code, so I have made the Rick code Bold, and that is what your code would be replacing.

Sub NextTab()
'-------------------------------------------------------Property(ies) Securing the Loan Section----------------------------------------------------------------
        If Range("B4").Value = "" Then
            MsgBox "Missing Street Address in 'Property(ies) Securing The Loan Section'"
Else
                If Range("C4").Value = "" Then
                    MsgBox "Missing City in 'Property(ies) Securing The Loan Section'"
Else
                    If Range("D4").Value = "" Then
                        MsgBox "Missing State in 'Property(ies) Securing The Loan Section'"
Else
                        If Range("E4").Value = "" Then
                            MsgBox "Missing Zip Code in 'Property(ies) Securing The Loan Section'"
Else
                            If Range("F4").Value = "(Select One)" Then
                                MsgBox "Missing Occupancy Type in 'Property(ies) Securing The Loan Section'"
Else
                                If Range("I4").Value = "" Then
                                    MsgBox "Missing Percent of Funds Being Allocated in 'Property(ies) Securing The Loan Section'"
Else
                                    If Range("J4").Value = "(Select One)" Then
                                        MsgBox "Missing Property Contains a Dwelling in 'Property(ies) Securing The Loan Section'"
Else
                                            If Range("K4").Value = "" Then
                                                MsgBox "Missing % Residential Use in 'Property(ies) Securing The Loan Section'"
Else
                                                    If Range("M4").Value = "" Then
                                                        MsgBox "Missing % Retail Use in 'Property(ies) Securing The Loan Section'"
Else
                                                            If Range("Q4").Value = "" Then
                                                                MsgBox "Missing Total (Dwelling) Units in 'Property(ies) Securing The Loan Section'"
Else
                                                                    If Range("R4").Value = "" Then
                                                                        MsgBox "Missing Multifamily Afforable Units in 'Property(ies) Securing The Loan Section'"
Else
                                                                            If Range("S4").Value = "(Select One)" Then
                                                                            MsgBox "Missing Construction Method in 'Property(ies) Securing The Loan Section'"
'-------------------------------------------------------HMDA Reportable Address Section----------------------------------------------------------------
Else
    If Range("B27").Value = "" Then
        MsgBox "Missing Street Address in 'HMDA Reportable Address Section'"
Else
            If Range("C27").Value = "" Then
                MsgBox "Missing City in 'HMDA Reportable Address Section'"
Else
                If Range("D27").Value = "" Then
                    MsgBox "Missing State in 'HMDA Reportable Address Section'"
Else
                        If Range("E27").Value = "" Then
                            MsgBox "Missing Zip Code in 'HMDA Reportable Address Section'"
Else
                                If Range("F27").Value = "(Select One)" Then
                                    MsgBox "Missing Occupancy Type in 'HMDA Reportable Address Section'"
Else
                                        If Range("K27").Value = "(Select One)" Then
                                            MsgBox "Missing Construction Method in 'HMDA Reportable Address Section'"
Else
                                                If Range("M27").Value = "(Select One)" Then
                                                    MsgBox "Missing Manufacured Home Secured Property Type in 'HMDA Reportable Address Section'"
Else
                                                        If Range("O27").Value = "(Select One)" Then
                                                            MsgBox "Missing Manufactured Home Land Property Interest in 'HMDA Reportable Address Section'"
'-------------------------------------------Checking Percentages----------------------------------------------------------------------------------------------------
Else
    If Range("I20").Value > 1 Then
        MsgBox "Funds allocated among properties cannot be greater than 100%"
        
'----------------------------------------------------------------------Checking Occupancy Type-------------------------------------------------------------------
Else
[B]    Dim LastRow As Long, RowNums As String
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  RowNums = Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(LEN(B1:B#)*(F1:F#=""(Select One)""),ROW(B1:B#),"""")", "#", LastRow))))), " ", ", ")
  If Len(RowNums) Then
    MsgBox "If an address is filled out in Column B, then a corresponding Type must be chosen in Column F." & vbLf & vbLf & "These rows have no Type selected: " & RowNums

*This is the Rick code that is currently there that your code would be replacing*[/B]
'-------------------------------------------------------------------------Next Tab---------------------------------------------------------------------------------------------
Else
    Sheets(1 + (ActiveSheet.Index Mod Sheets.Count)).Select
End If
        End If
            End If
                End If
                    End If
                        End If
                            End If
                                End If
                                    End If
                                        End If
                                            End If
                                                End If
                                                    End If
                                                        End If
                                                            End If
                                                                End If
                                                                    End If
                                                                        End If
                                                                            End If
                                                                                End If
                                                                                    End If
                                                                                        End If
End Sub

 

[L. Howard]

My code CheckTypeSelected is in a standard module as well as the code you posted.
I had a small measure of success calling my code in the If Range("F4").Value = "" Then segment, as shown in this extract snippet of your code below.
But this is only good for row 4 of column F, does nothing for the other rows in F with a (Select One) in them.

So do you have a similar code for EVERY row to check if there is data missing?
I wonder if you need a code that checks the entire row range for omissions sorta like the end of my code does for the Q R S T U rows.

Howard

Else
                        If Range("E4").Value = "" Then
                            MsgBox "Missing Zip Code in 'Property(ies) Securing The Loan Section'"
Else
                            If Range("F4").Value = "(Select One)" Then
                                MsgBox "Missing Occupancy Type in 'Property(ies) Securing The Loan Section'"
                               [I][B] CheckTypeSelected[/B][/I]
Else
                                If Range("I4").Value = "" Then
                                    MsgBox "Missing Percent of Funds Being Allocated in 'Property(ies) Securing The Loan Section'"
Else

 

[SanFelippo]

Not necessarily every single row no, because there are some that may not always be able to filled out based on the information given. These columns however, F, Q, R, S. T, and U are the ones that absolutely need to be filled in if an address is populated in column B.

I had a thought (It may be a dumb one, as I am not to well versed in VBA but whatever, mine as well try). What stops us from just creating a few new variables, or rather Strings for the other rows that need to be filled out just like column F and coding them similar to how the Rick code did? What I mean is something like this (No way this works in anyway yet, but maybe we could get it to):

Dim LastRow As Long, RowNumF As String, RowNumQ As String, RowNumR As String, RowNumS As String, RowNumT As String, RowNumU As String
  LastRow = Cells(Rows.Count, "B").End(xlUp).Row
  RowNumF = Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(LEN(B1:B#)*(F1:F#=""(Select One)""),ROW(B1:B#),"""")", "#", LastRow))))), " ", ", ")

  RowNumQ = Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(LEN(B1:B#)*(Q1:Q#="" ""),ROW(B1:B#),"""")", "#", LastRow))))), " ", ", ")

  RowNumR = Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(LEN(B1:B#)*(R1:R#="" ""),ROW(B1:B#),"""")", "#", LastRow))))), " ", ", ")

  RowNumS = Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(LEN(B1:B#)*(S1:S#=""(Select One)""),ROW(B1:B#),"""")", "#", LastRow))))), " ", ", ")

  RowNumT = Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(LEN(B1:B#)*(T1:T#=""(Select One)""),ROW(B1:B#),"""")", "#", LastRow))))), " ", ", ")

  RowNumU = Replace(Application.Trim(Join(Application.Transpose(Evaluate(Replace("IF(LEN(B1:B#)*(U1:U#=""(Select One)""),ROW(B1:B#),"""")", "#", LastRow))))), " ", ", ")
  
  If Len(RowNumF) Then
    MsgBox "If an address is filled out in Column B, then a corresponding Type must be chosen in Column F." & vbLf & vbLf & "These rows have no Type selected: " & RowNumF

'Else
    'If Len(RowNumQ) Then
    'MsgBox "If an address is filled out in Column B, then a corresponding Total (Dwelling) Units must be chosen in Column Q." & vbLf & vbLf & "These rows have no Total (Dwelling) Units selected: " & RowNumQ

Couldn't we then get the code to run through each of those situations some how? I did try to make it work for Column Q, but it seemed to just skip right over that and move onto the next tab.

Do you see what I am trying to suggest? Sorry if it's hard to understand.

 

[L. Howard]

Can you post a link to an example workbook? That would be helpful to see the whole picture and better understand the entire scope of what you are trying to get accomplished. You cannot do an attachment here but a link is okay. You can use one of the link utilities to do that, I use Drop Box, but there are others.

Rick's codes are rock solid as code can be, but expanding it may take someone like Rick himself to do so. I thought my code in combo with Rick's checked both B & F columns and Q R S T U columns row for blanks.

Howard