Expanding a Macro Already Written

SanFelippo · Jun 22, 2017

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)

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

Code:

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 · Sep 14, 2017

I am working on the Peckin' Order portion.

Have a pretty good solution using mostly formulas to put the 'high score' row into row 27.

I notice what has become a problem using the formula as they rely on column headers for the info transfers to row 27.

Q3, I26 and AJ3 all have different Header titles, but the entries are all the same. Is there any reason why they are all different?
I need those headers to be the same for the formulas to work properly. I have "normalized" them on my test sheet and the formulas work nicely.

Howard

L. Howard · Sep 15, 2017

Here are the Peckin' Order formulas. There are two formulas to pull down in column X and AO row 3 to 18 and one formula to pull across from B27 to Q27.

The row 27 will show the data for the LARGE value of either the X column or the AO column.

Howard

Excel 2012

X

1

2

3

4

3

4. Property Information

Cell Formulas
Range	Formula
X4	=(ISNUMBER(--LEFT(B4,1)))+(J4="Yes")+(ISNUMBER(FIND("Principal",F4)))+(K4=MAX($K$4:$K$18))+(I4=MAX($I$4:$I$18))+(O4=MAX($O$4:$O$18))

Excel 2012

AO

1

2

3

4

1

4. Property Information

Cell Formulas
Range	Formula
AO4	=(ISNUMBER(--LEFT(Z4,1)))+(AF4="Yes")+(ISNUMBER(FIND("Principal",AD4)))+(AG4=MAX($AG$4:$AG$18))+(AE4=MAX($AE$4:$AE$18))+(AI4=MAX($AI$4:$AI$18))

Excel 2012

B

26

Street Address

27

124 WEST 21

4. Property Information

Cell Formulas
Range	Formula
B27	=IF($AO$20>$X$20,INDEX($Z$4:$AN$18,MATCH(MAX($AO$4:$AO$18),$AO$4:$AO$18,0),MATCH(B$26&"",$Z$3:$AN$3,0)),INDEX($B$4:$U$18,MATCH(MAX($X$4:$X$18),$X$4:$X$18,0),MATCH(B$26&"",$B$3:$U$3,0)))

SanFelippo · Sep 15, 2017

I don't know why they gave them different header titles. I am not going to wait for a response from them, you can change them all to "Total Units"

Does that formula go into every cell in B27? That's what it looks like, because the index match functions will walk as you drag it, but I just want to be sure

SanFelippo · Sep 15, 2017

Also it looks like I forgot to hit submit the last time I tried to reply. Could you post your entire Sub_Next_Tab_4() code? I am wondering exactly where you put it into the Next coding? Before the coding that moves onto the next tab?

L. Howard · Sep 15, 2017

SanFelippo said:
Does that formula go into every cell in B27? That's what it looks like, because the index match functions will walk as you drag it, but I just want to be sure

Yes, formula goes in B27 and is pulled across.

IMPORTANT: I overlooked two formulas also needed.

In cells...

X20 =MAX(X4:X18)
AO20 =MAX(AO4:AO18)

The formulas in row 27 refer to these two cells to decide which column, X or AO, holds the LARGE row to be shown in row 27.

REF the Sub_Next_Tab_4() & audit code:

I will have to re-write audit code into Sub_Next_Tab_4(). Lost the one I had...???

Howard

L. Howard · Sep 15, 2017

Here is the Next_Tab_4 code with the message box alert - "audit option", "next sheet" at the end.

Howard

Code:

Option Explicit

Sub Next_Tab_4()
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 Msg, ans, Cancel
 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
 

        Msg = "Sufficient Info Has Been Provided." & vbCr & _
              "Do you want to:" & vbCr & _
              "               Run Audit Macro," & vbCr & _
              "               Move to next Tab," & vbCr & _
              "               CANCEL and exit." & vbCr & vbCr & _
              "Click ""Yes"" to run Audit Macro" & vbCr & _
              "Click ""No"" to move on" & vbCr & _
              "CANCEL and do nothing"
        
        ans = MsgBox(Msg, vbQuestion + vbYesNoCancel)
        
        Select Case ans
        
            Case vbYes
                MsgBox "Yes was clicked, macro run."
                Sheet_Audit_Q_AJ_O_AI_S_AL
               
            Case vbNo
                MsgBox "Sheets(""5. Purpose of Loan"") coming up."
                  Sheets("5. Purpose of Loan").Visible = True
                  Sheets("5. Purpose of Loan").Activate

            Case vbCancel
                MsgBox """Cancel"" - Good Bye!"
                Cancel = True
               
          End Select
 
  End If

End With

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

End Sub



Sub Sheet_Audit_Q_AJ_O_AI_S_AL()
Dim oRng As Range, aiRng As Range, o As Range, ai As Range
Dim qRng As Range, ajRng As Range, q As Range, aj As Range
Dim sRng As Range, alRng As Range
Dim s As Range, al As Range

With Sheets("4. Property Information")

 Set oRng = .Range("O4:O18")
 Set aiRng = .Range("AI4:AI18")
 Set qRng = .Range("Q4:Q18")
 Set ajRng = .Range("AJ4:AJ18")
 Set sRng = .Range("S4:S18")
 Set alRng = .Range("AL4:AL18")
 
 For Each q In qRng
   If q.Value <= 4 And Len(q.Offset(, -15)) <> 0 Then q.Offset(, 1) = "N/A"
 Next
 
 
 For Each aj In ajRng
   If aj.Value <= 4 And Len(aj.Offset(, -10)) <> 0 Then aj.Offset(, 1) = "N/A"
 Next
 For Each o In oRng
  If Range("R23").Value = 4 And Len(o.Offset(, -13)) <> 0 Then o = "N/A"
  If Range("R23").Value = 5 And Len(o.Offset(, -13)) <> 0 Then o = "N/A"
 Next
 
 For Each ai In aiRng
 
  If Range("R23").Value = 4 And Len(ai.Offset(, -9)) <> 0 Then ai = "N/A"
  If Range("R23").Value = 5 And Len(ai.Offset(, -9)) <> 0 Then ai = "N/A"
 Next
 
 For Each s In sRng
  If Range("S23").Value = "Private Banking" And Len(s.Offset(, -17)) <> 0 Then s = "Site-Built"
 Next
 
 For Each al In alRng
  If Range("S23").Value = "Private Banking" And Len(al.Offset(, -12)) <> 0 Then al = "Site-Built"
 Next
 
End With
End Sub

SanFelippo · Sep 25, 2017

I apologize for the long absence. I was on a road trip way out west for the last week (Over 3,000 miles). I have tested everything and it seems to work beautifully. I will of course respond on here again if anything changes. Again, thanks a bunch!

L. Howard · Sep 25, 2017

Great, glad it works for you.

Posting back here for further help is okay, but posting to the forum with the specifics of the problem will reach a wealth of expertise beyond mine own. Mostly one does not need to know about the entire workbook to be of help. I actually had to post to an super-expert I know and he came up with the formulas for the row 27 caper.

Howard

SanFelippo · Oct 9, 2017

I enjoy your expertise haha. And I do have 2 small requests?

The first requests will involve Column K (%Residential Use) and Column M (% Retail Use), and then the second will involve Column Q (Total Units) and Column R (Multifamily Affordable Units). This coding of course would then need to be applied to the columns AG and AH, AJ and AK.

First request (Can be done in the "Next" Macro):

If there is an address filled out in Column B/Z, then the sum of %Residential Use (Column K/M) and % Retail Use (Column AG/AH) must be 100%.

Perhaps just have a pop up box come up stating the their sums must equal 100% if they do not when Next is hit?

Second request (Can be done in the Worksheet Change Macro:

If there is an address filled out in Column B/Z, then if the number in Total Units (Column Q/AJ) is less than or equal to 4, then Multifamily Affordable Units (Column R/AK) must be set to N/A.

If there is an address filled out in Column B/Z, then if the number in Total Units (Column Q/AJ) is greater than or equal to 5, then Multifamily Affordable Units (Column R/AK) is simply left alone but still required to be completed before you can hit next (I think this is already taken care of).

L. Howard · Oct 10, 2017

SanFelippo said:
First request (Can be done in the "Next" Macro):

If there is an address filled out in Column B/Z, then the sum of %Residential Use (Column K/M) and % Retail Use (Column AG/AH) must be 100%.

Perhaps just have a pop up box come up stating the their sums must equal 100% if they do not when Next is hit?

With this statement??? "If there is an address filled out in Column B/Z,,,"

I read as if there is NO address filled out in either column, then the sheet is not being used and of course no action required.
If there is an (ONE ?) address filled in out in column B (Z will not be used until B is full) then the sum of % Residential Use (Column K/M) and % Retail Use must be 100%.

Second request (Can be done in the Worksheet Change Macro:

If there is an address filled out in Column B/Z, then if the number in Total Units (Column Q/AJ) is less than or equal to 4, then Multifamily Affordable Units (Column R/AK) must be set to N/A.

If there is an address filled out in Column B/Z, then if the number in Total Units (Column Q/AJ) is greater than or equal to 5, then Multifamily Affordable Units (Column R/AK) is simply left alone but still required to be completed before you can hit next (I think this is already taken care of).

You have these audit codes don't you?

Howard

Code:

Sub Sheet_Audit_Q_AJ_O_AI_S_AL()
Dim oRng As Range, aiRng As Range, o As Range, ai As Range
Dim qRng As Range, ajRng As Range, q As Range, aj As Range
Dim sRng As Range, alRng As Range
Dim s As Range, al As Range

With Sheets("4. Property Information")
 Set oRng = .Range("O4:O18")
 Set aiRng = .Range("AI4:AI18")
 Set qRng = .Range("Q4:Q18")
 Set ajRng = .Range("AJ4:AJ18")
 Set sRng = .Range("S4:S18")
 Set alRng = .Range("AL4:AL18")
 
 For Each q In qRng
   If q.Value <= 4 And Len(q.Offset(, -15)) <> 0 Then q.Offset(, 1) = "N/A"
 Next
 
 
 For Each aj In ajRng
   If aj.Value <= 4 And Len(aj.Offset(, -10)) <> 0 Then aj.Offset(, 1) = "N/A"
 Next
 For Each o In oRng
  If Range("R23").Value = 4 And Len(o.Offset(, -13)) <> 0 Then o = "N/A"
  If Range("R23").Value = 5 And Len(o.Offset(, -13)) <> 0 Then o = "N/A"
 Next
 
 For Each ai In aiRng
 
  If Range("R23").Value = 4 And Len(ai.Offset(, -9)) <> 0 Then ai = "N/A"
  If Range("R23").Value = 5 And Len(ai.Offset(, -9)) <> 0 Then ai = "N/A"
 Next
 
 For Each s In sRng
  If Range("S23").Value = "Private Banking" And Len(s.Offset(, -17)) <> 0 Then s = "Site-Built"
 Next
 
 For Each al In alRng
  If Range("S23").Value = "Private Banking" And Len(al.Offset(, -12)) <> 0 Then al = "Site-Built"
 Next
 
End With
End Sub


Sub Column_O_AI_Audit()
Dim oRng As Range, aiRng As Range, o As Range, ai As Range

With Sheets("4. Property Information")
 Set oRng = .Range("O4:O18")
 Set aiRng = .Range("AI4:AI18")

 For Each o In oRng
' MsgBox Range("R23").Value & " " & Len(o.Offset(, -13))
  If Range("R23").Value = 4 And Len(o.Offset(, -13)) <> 0 Then o = "N/A"
  If Range("R23").Value = 5 And Len(o.Offset(, -13)) <> 0 Then o = "N/A"
 Next
 
 For Each ai In aiRng
' MsgBox Range("R23").Value & " " & Len(ai.Offset(, -9))
  If Range("R23").Value = 4 And Len(ai.Offset(, -9)) <> 0 Then ai = "N/A"
  If Range("R23").Value = 5 And Len(ai.Offset(, -9)) <> 0 Then ai = "N/A"
 Next
 
End With
End Sub

Sub Column_Q_AJ_Audit()
Dim qRng As Range, ajRng As Range, q As Range, aj As Range

With Sheets("4. Property Information")
 Set qRng = .Range("Q4:Q18")
 Set ajRng = .Range("AJ4:AJ18")
 
 For Each q In qRng
   If q.Value <= 4 And Len(q.Offset(, -15)) <> 0 Then q.Offset(, 1) = "N/A"
 Next
 
 For Each aj In ajRng
   If aj.Value <= 4 And Len(aj.Offset(, -10)) <> 0 Then aj.Offset(, 1) = "N/A"
 Next
 
End With
End Sub

Expanding a Macro Already Written

SanFelippo

Board Regular

L. Howard

Well-known Member

Excel Facts

L. Howard

Well-known Member

SanFelippo

Board Regular

SanFelippo

Board Regular

L. Howard

Well-known Member

L. Howard

Well-known Member

SanFelippo

Board Regular

L. Howard

Well-known Member

SanFelippo

Board Regular

L. Howard

Well-known Member

Similar threads

Forum statistics

Share this page

Expanding a Macro Already Written

Board Regular

Well-known Member

Excel Facts

Well-known Member

Board Regular

Board Regular

Well-known Member

Well-known Member

Board Regular

Well-known Member

Board Regular

Well-known Member

Similar threads

Forum statistics

Share this page

We've detected that you are using an adblocker.

Which adblocker are you using?

Disable AdBlock

Disable AdBlock Plus

Disable uBlock Origin

Disable uBlock