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]

For the no. 7 item on the to do list give this a try. REF: Columns S, T, U, AL, AM, AN.

Discard previous sheet 4. Property Information module Change Event macro and paste this in it place.

I don't know what column U and AN are supposed to have in it if column S or AL have "Manufactured Home" in it ???

Howard

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub

Dim sRng As Range, alRng As Range

If (Range("I20") / 1) > 1 Then
  MsgBox "Funds allocated among properties cannot be greater than 100%" & vbCr & _
         "Review values in Columns I and AE"
End If

'*********************************************
 If Intersect(Target, Range("S4:T18, AL4:AM18")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
 
  If Target.Value = "Site-built" Then

     Target.Offset(, 1).Resize(1, 2) = "Not Applicable"
     Target.Offset(, 2).Activate

    ElseIf Target.Value = "Manufactured Home" Then
    
      With Target

        .Offset(, 1).ClearContents
        .Offset(, 1).Activate
        MsgBox "    Construction Method is ""Manufactured Home.""" & vbCr & _
               "      Secured Property type must be either." & vbCr & vbCr & _
               "          ""Manufactured home and land"" " & vbCr & _
               "                                 or" & vbCr & _
               "       ""Manufactured home and not land""", vbExclamation, "This is the Title"

      End With
         
    End If
    
        If Target.Value = "Not applicable" Or Target.Value = "(Select One)" Then
        
          MsgBox Target.Value & " is NOT allowed:"
          Target.ClearContents
          Target.Activate
         
        End If
   
'///////////////////////////////////////////////////////////////////


If Intersect(Target, Range("B4:D18,Z4:AB18,S4:S18")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
 
If InStr(1, Target, ",") > 0 Or InStr(1, Target, ";") > 0 Then

   Application.EnableEvents = False

   With Target
    .Replace What:=",", Replacement:="", LookAt:=xlPart
    .Replace What:=";", Replacement:="", LookAt:=xlPart
   End With
 
   Application.EnableEvents = True
 
  Else
 
   Application.EnableEvents = True
   Exit Sub
 
End If

 MsgBox "Comma's or Semi-Colon's removed from " & Target.Address(False, False)
 
End Sub

 

[L. Howard]

I believe this version addresses the "to-do" list, with perhaps one extra Conditional Formatting function for columns T and AM. Prevents user from "coming back" to either column and re-selecting (Select One) or Not applicable in column in T or AM when there is Manufactured Home in column S or AL. The code prevents it from happening when user is entering data in a normal sequence. But one can return later and select one of the no-no entries. I have conditional formatting poised to present a RED fill if either is selected.

For the row 20 protection, I used this guideline to do that. You need only go to Review tab > click Protect Sheet (no password).

To leave the majority of the cells on the worksheet unlocked, follow these steps:

1. Select the entire worksheet by clicking the Select All button (the gray rectangle in the upper-left corner of the worksheet where the row 1 and column A headings meet), or by pressing CTRL+A or CTRL+SHIFT+SPACEBAR.

2. Show the format cells dialog box by clicking the Expand button to the bottom right of the Font section of the Home ribbon, and then click Protection tab. Click to clear the Locked check box and click OK.

3. Select the cells that you want to protect. To select nonadjacent (noncontiguous) cells, hold down CTRL and click the cells that you want to protect.

4. Return to the Format Cells dialog box, and then click the Protection tab. Click to select the Locked check box, and then click OK.

5. In Excel click the Review tab, and click Protect Sheet. Type a password, if you want one, and then click OK.

Here is a link to the latest version of my test sheet.
Conditional Formatting and Data Validation formulas are in the row 1 & 2 of the column they are used in, see row 21 & 22 for columns T & AM where the 2nd and 3rd Condition for them is listed.

The codes used are below the link.


https://www.dropbox.com/s/x2pcnzyxvbcej0t/Expanding a Macro Already Written DBox_1.xlsm?dl=0


Howard


In the sheet module.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub

Dim sRng As Range, alRng As Range

If (Range("I20") / 1) > 1 Then

  MsgBox "Funds allocated among properties cannot be greater than 100%" & vbCr & _
         "Review values in Columns I and AE"

End If


 If Intersect(Target, Range("B4:E18,B27:E27,Z4:AB18,S4:T18, AL4:AM18")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
 
  If Target.Value = "Site-built" Then

     Target.Offset(, 1).Resize(1, 2) = "Not Applicable"
     Target.Offset(, 2).Activate

    ElseIf Target.Value = "Manufactured Home" Then
    
      With Target
        .Offset(, 1).ClearContents
        .Offset(, 1).Activate
        MsgBox "    Construction Method is ""Manufactured Home.""" & vbCr & _
               "      Secured Property type must be either." & vbCr & vbCr & _
               "          ""Manufactured home and land"" " & vbCr & _
               "                                 or" & vbCr & _
               "       ""Manufactured home and not land""", vbExclamation, "This is the Title"
               
        .Offset(, 2) = "Not Applicable"
        .Offset(, 1).Activate
 
      End With
    End If
 
 
  If InStr(1, Target, ",") > 0 Or InStr(1, Target, ";") > 0 Then
 
    With Target
     .Replace What:=",", Replacement:="", LookAt:=xlPart
     .Replace What:=";", Replacement:="", LookAt:=xlPart
    End With
 
   Else
 
    Exit Sub
 
  End If

    MsgBox "Comma's or Semi-Colon's removed from " & Target.Address(False, False)
 
End Sub

In a standard module.

Option Explicit

Sub NextTab_1_BZ()
Dim bRow As Long, LRowB As Long, LRowZ As Long, cCnt As Long
Dim OneRng As Range, c As Range
Dim cc As String
Dim i As Integer, J As Integer, n As Integer, m As Integer
Dim varColsB() As Variant
Dim varColsZ() As Variant
Dim myCheck
   
With ActiveWorkbook.Worksheets("4. Property Information")

  If (Range("I20") / 1) > 1 Then

     MsgBox "Funds allocated among properties cannot be greater than 100%" & vbCr & _
            "Review values in Columns I and AE"
     Exit Sub

  End If

   For i = 2 To 5
   
      ReDim Preserve varColsB(n)
      varColsB(n) = .Cells(19, i).End(xlUp).Row
      n = n + 1
      
   Next
   
   
   For J = 26 To 29
   
      ReDim Preserve varColsZ(m)
      varColsZ(m) = .Cells(19, J).End(xlUp).Row
      m = m + 1
      
   Next
   
   LRowB = Application.Max(varColsB)
   LRowZ = Application.Max(varColsZ)
   
    If LRowB <> 18 And LRowZ > 3 Then
      MsgBox "There are empty rows in B column." & vbCr & vbCr & _
             "Fill B column rows before using Z column rows.", vbOKOnly + vbCritical, "Bad Row Ahoy!"
      
      Exit Sub

    End If
   
   
   If LRowB < 19 And LRowZ = 3 Then
  
       Set OneRng = Union(.Range("B4:M" & LRowB), _
                          .Range("Q4:U" & LRowB), _
                          .Range("B27:O27")).SpecialCells(xlCellTypeVisible)
                          
     ElseIf LRowB = 18 And LRowZ > 3 Then
    
      Set OneRng = Union(.Range("B4:M" & LRowB), _
                          .Range("Q4:U" & LRowB), _
                          .Range("Z4:AH" & LRowZ), _
                          .Range("AJ4:AN" & LRowZ), _
                          .Range("B27:O27")).SpecialCells(xlCellTypeVisible)
      
   End If
     
     
   For Each c In OneRng
   
      If c = "" Or c = "(Select One)" Then

         cc = cc & ", " + c.Address(False, False)
         cCnt = cCnt + 1

      End If
      
   Next
   
   If cCnt > 0 Then
   
      .Range(Mid(cc, 3)).Select
      MsgBox "There are  " & cCnt & _
            " cells with ""Blank"" or ""(Select One)"" in these cell Address':" _
            & vbCr & vbCr & Mid(cc, 3)

     Else
   
      myCheck = MsgBox("All data point are positive." & vbCr & "Unhide Sheets(Lists)?", vbYesNo)
    
    If myCheck = vbNo Then
       '
      Else
      'MsgBox "No sheet. Test only"
        Sheets("(Lists)").Visible = True
        Sheets("(Lists)").Activate
    End If
   
  End If

End With


End Sub

 

[SanFelippo]

Howard,

Wow. Thanks a bunch! I was out of town this last Thursday to Monday, but in the next two days I am going to review and test the code. I will let you know if there is anything goofy, but either way, I can't thank you enough for your help.

 

[L. Howard]

Okay, good. Wring it out and we'll see if anything needs adjusting. Most often it does.

I have a Data Validation formula for the comma/semi-colon issues for columns B C D. It alerts but does not remove them.
As an innocent bystander, I prefer the removal by code (as in the linked workbook).

Howard

 

[SanFelippo]

Howard,

I have gone through and identified the following things I am hoping can be easily tweaked:

7. If Construction Method in column S or AL = "Site-Built",then columns T-U and AM-AN must default to "Not Applicable"respectively. If Construction Method in column S or AL = "ManufacturedHome", then columns T-U and AM-AN must be highlighted light blue and arethen required to be completed.

The first part of this requirement works perfectly. For the second piece however, if the construction method is set to "manufactured home" in column S, I simply need column T and Column U to be required to be completed.There is no specific entry needed, they just need to choose something other than "(Select One)". The same goes for Column AL, and then AM and AN.

5. If B4 is the only address cell that has text in it, then I4 must =100%. If there is an address entered in more than one address cell in column B,then I4 opens up an allows free form text to be entered (AKA, so that thecorrect percentage allocated to that address can be entered.

It looks like we are missing this piece. basically, it is saying that if thereis only one address entered (AKA only row 4 is filled out through column U),then I4 needs to be 100%. I think the easiest way to go about that would be to put in in the next button code? So once you press next, it would check to see if only one address is entered, and if so, automatically set Cell I4 to100%?

9. Highlight the highest percentage amount thatresides in Column I, ce

lls 4-18 yellow. Do the same for Column AE,cells 4-18.

This one was actually my fault. I worded it badly. Ratherthan being two separate conditional formats, I need it to highlight yellow the highest percentage between Column I, cells 4-18 and Column AE, cells 4-18. So there will only be one cell highlighted between all of those.<o></o>
<o> </o>
There is also one more thing I am hoping to add. I would like the code to run through and check column J, cells 4-18 and Column AF,cells 4-18 and make sure that between all of those cells, there is at least one of them that is answered “Yes”. If there is not one answered “Yes”, an error box would pop up stating “In order to be HMDA reportable, a property must contain a dwelling.”


Also, it appears that if I try and protect the cells in rows 19 and 20, it doesn't allow the next button Macro to run? It gives me an error that says "You cannot use this command on a protected sheet......" Is there anyway to protect the cells I want to but still allow the Macro buttons and Macros themselves to function?

 

[L. Howard]

I think I got the changes made, give it a test flight and let me know.

The sheet protection is taken care of with the code in the standard module, assigned to NEXT button. When you run the code the sheet is unprotected and protected at the end of the code.

The link in post #42 should be current.

Howard



Here are the slightly revised coded. The rest was done with data valid. and conditional formatting.

The sheet code.

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim sRng As Range, alRng As Range

If (Range("I20") / 1) > 1 Then
  MsgBox "Funds allocated among properties cannot be greater than 100%" & vbCr & _
         "Review values in Columns I and AE"
End If
 If Intersect(Target, Range("B4:E18,B27:E27,Z4:AB18,S4:T18, AL4:AM18")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
 
  If Target.Value = "Site-built" Then

     Target.Offset(, 1).Resize(1, 2) = "Not Applicable"
     Target.Offset(, 2).Activate

    ElseIf Target.Value = "Manufactured Home" Then
    
      With Target

        .Offset(, 1).Activate
        MsgBox "      Construction Method is ""Manufactured Home.""" & vbCr & _
               "      ""Secured Property"" type and ""Property Interest""" & vbCr & _
               "                               cannot be..." & vbCr & vbCr & _
               "                 ""(Select One)"" or ""Not Applicable""", _
               vbExclamation, "BLUE CELL FILL ME!"
               
        .Offset(, 2) = "Not Applicable"
        .Offset(, 1).Activate
 
      End With

    End If

  If InStr(1, Target, ",") > 0 Or InStr(1, Target, ";") > 0 Then
 
    With Target
     .Replace What:=",", Replacement:="", LookAt:=xlPart
     .Replace What:=";", Replacement:="", LookAt:=xlPart
    End With
 
   Else
 
    Exit Sub
 
  End If
    MsgBox "Comma's or Semi-Colon's removed from " & Target.Address(False, False)
 

End Sub

The standard module code.

Sub NextTab_1_BZZ()
Dim bRow As Long, LRowB As Long, LRowZ As Long, cCnt As Long
Dim OneRng As Range, c As Range, rIAF As Range, rAF As Range
Dim cc As String
Dim i As Integer, J As Integer, n As Integer, m As Integer
Dim varColsB() As Variant
Dim varColsZ() As Variant
Dim myCheck

 ActiveSheet.Unprotect
   
With ActiveWorkbook.Worksheets("4. Property Information")
 
  If Application.WorksheetFunction.CountA(Range("B4:E18")) = 4 Then
     Range("I5:I18,K5:K18,AE4:AE18") = 0
     Range("I4") = 100 / 100
  End If
  
  If (Range("I20") / 1) > 1 Then
     MsgBox "Funds allocated among properties cannot be greater than 100%" & vbCr & _
            "Review values in Columns I and AE"
     Exit Sub
  End If
  
 
   For i = 2 To 5
   
      ReDim Preserve varColsB(n)
      varColsB(n) = .Cells(19, i).End(xlUp).Row
      n = n + 1
      
   Next
   
   
   For J = 26 To 29
   
      ReDim Preserve varColsZ(m)
      varColsZ(m) = .Cells(19, J).End(xlUp).Row
      m = m + 1
      
   Next
   
   LRowB = Application.Max(varColsB)
   LRowZ = Application.Max(varColsZ)
   
    If LRowB <> 18 And LRowZ > 3 Then
      MsgBox "There are empty rows in B column." & vbCr & vbCr & _
             "Fill B column rows before using Z column rows.", vbOKOnly + vbCritical, "Bad Row Ahoy!"
      
      Exit Sub
    End If
   
   
   If LRowB < 19 And LRowZ = 3 Then
  
       Set OneRng = Union(.Range("B4:M" & LRowB), _
                          .Range("Q4:U" & LRowB), _
                          .Range("B27:O27")).SpecialCells(xlCellTypeVisible)
                          
     ElseIf LRowB = 18 And LRowZ > 3 Then
    
      Set OneRng = Union(.Range("B4:M" & LRowB), _
                          .Range("Q4:U" & LRowB), _
                          .Range("Z4:AH" & LRowZ), _
                          .Range("AJ4:AN" & LRowZ), _
                          .Range("B27:O27")).SpecialCells(xlCellTypeVisible)
      
   End If
     
     
   For Each c In OneRng
   
      If c = "" Or c = "(Select One)" Then
         cc = cc & ", " + c.Address(False, False)
         cCnt = cCnt + 1
      End If
      
   Next
   
   If cCnt > 0 Then
   
      .Range(Mid(cc, 3)).Select
      MsgBox "There are  " & cCnt & _
            " cells with ""Blank"" or ""(Select One)"" in these cell Address':" _
            & vbCr & vbCr & Mid(cc, 3)
     Else
     
   
     Set rIAF = Range("J4:J18,AF4:AF18")
         
    
    If Application.WorksheetFunction.CountIf(Range("J4:J18"), "Yes") + Application.WorksheetFunction.CountIf(Range("AF4:AF18"), "Yes") < 1 Then
       MsgBox " “In order to be HMDA reportable," & vbCr & _
              "a property must contain a dwelling.”  " & vbCr & vbCr & _
       "      Recheck columns J and AF!", vbOKOnly + vbCritical, "MUST BE A YES"
      
      rIAF.Select
      Exit Sub

    End If
  
  
   
      myCheck = MsgBox("All data point are positive." & vbCr & "Unhide Sheets(Lists)?", vbYesNo)
    
    If myCheck = vbNo Then
       '
      Else

      'MsgBox "No sheet. Test only"
        Sheets("(Lists)").Visible = True
        Sheets("(Lists)").Activate

    End If
   
  End If

End With

Sheets("4. Property Information").Protect DrawingObjects:=True, Contents:=True, Scenarios:=True

End Sub

 

[SanFelippo]

Howard,

The code seems to still be changing Column U and AN to "Not Applicable" When Manufactured Home is selected in column S and AL respectively.

Also, once I switch out the Module code for the one above, I am getting an error when I try and hit "Next" that says "Cannot run the macro "(Name of Macro)". The macro may not be available in this workbook or all macros may be disabled"

Not sure why?

 

[L. Howard]

Also, once I switch out the Module code for the one above, I am getting an error when I try and hit "Next" that says "Cannot run the macro "(Name of Macro)". The macro may not be available in this workbook or all macros may be disabled"

You copied the revised code to your workbook, which has a tiny different name as the previous code.
The NEXT button is looking for code named Sub NextTab_1_BZ() the current code is Sub NextTab_1_ BZZ().
I did that to more easily tell the old code from the new code.
Reassign the new ZZ code to the NEXT button.

The code seems to still be changing Column U and AN to "Not Applicable" When Manufactured Home is selected in column S and AL respectively.

In the sheet code find the two line I have marked here with '/////// in RED, and delete them in your workbook.
Or use this code and delete the red font lines.

Howard

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
Dim sRng As Range, alRng As Range

If (Range("I20") / 1) > 1 Then
  MsgBox "Funds allocated among properties cannot be greater than 100%" & vbCr & _
         "Review values in Columns I and AE"
End If
 If Intersect(Target, Range("B4:E18,B27:E27,Z4:AB18,S4:T18, AL4:AM18")) Is Nothing Or Target.Cells.Count > 1 Then Exit Sub
 
  If Target.Value = "Site-built" Then
     Target.Offset(, 1).Resize(1, 2) = "Not Applicable"
     Target.Offset(, 2).Activate
    ElseIf Target.Value = "Manufactured Home" Then
    
      With Target
        .Offset(, 1).Activate
        MsgBox "      Construction Method is ""Manufactured Home.""" & vbCr & _
               "      ""Secured Property"" type and ""Property Interest""" & vbCr & _
               "                               cannot be..." & vbCr & vbCr & _
               "                 ""(Select One)"" or ""Not Applicable""", _
                                 vbExclamation, "BLUE CELL FILL ME!"
               
[COLOR=#FF0000] '///////DELETE//////.Offset(, 2) = "Not Applicable"
 '///////DELETE//////.Offset(, 1).Activate[/COLOR]
 
      End With
    End If

  If InStr(1, Target, ",") > 0 Or InStr(1, Target, ";") > 0 Then
 
    With Target
     .Replace What:=",", Replacement:="", LookAt:=xlPart
     .Replace What:=";", Replacement:="", LookAt:=xlPart
    End With
 
   Else
 
    Exit Sub
 
  End If
    MsgBox "Comma's or Semi-Colon's removed from " & Target.Address(False, False)
 
End Sub

 

[SanFelippo]

Okay!

It looks like we have everything in here except this one last piece.

Highlight Yellow the highest percentage that resides in column I cells 4-18 and column AE, cells 4-18. Rather than being two separate conditional formats, I need it to highlight yellow the highest percentage between Column I, cells 4-18 and Column AE, cells 4-18. So there will only be one cell highlighted between all of those.<o></o>

 

[L. Howard]

Hmm, had it on my test workbook, but not in the linked workbook. Although it is now.

It is a conditional format...

Unprotect sheet > select both columns I and AE rows 4 to 18 > Home tab > Conditional Formatting > Highlight cell rules > More rules > Format only top or bottom ranked values > Top > 1 > Format > Fill > select yellow > OK > OK. Protect sheet

Howard