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

 

[SanFelippo]

I would be more than happy to do that. Unfortunately I am not sure how to go about doing that on here? Sorry to ask, but could you give me a walkthrough?

 

[L. Howard]

With drop box I save the workbook to the drop box folder. Then you click on the drop box Icon and there are options where you are able to save the link to the clip board and then you paste it in your post here with a Ctrl + v.

Howard

 

[SanFelippo]

You are going to need to let me know if this link works, I can't get dropbox to load on the computer, so I had to do some back and forth with my phone, email, and the dropbox app to get a link for it.

https://www.dropbox.com/s/ixgsyy6omz5ahl7/Example%20Workbook.xlsm?dl=0

 

[L. Howard]

I have the workbook.

Restate how the sheet is supposed to work, a step by step scenario of how you use the sheet and what you want any coding (macros) to do for you and when to do it.


Howard

 

[L. Howard]

I find that there are five hidden columns on sheet 4. Property Information, how do these fit or play into the sheets functions? Some seem to have pertinent data in them and others are blank.

Howard

 

[L. Howard]

Give this a try, where the code considers only the visible cells in the B4:S18 range.

Copy to a standard module, not the sheet module.

Hidden sheet (Lists) must be unhidden or an error will occur. There is code to unhide it.

Howard

Option Explicit

Sub NextTab_1()
Dim bRow As Long, cCnt As Long
Dim OneRng As Range, c As Range
Dim cc As Variant

With ActiveWorkbook.Worksheets("4. Property Information")
  
 Set OneRng = Range("B4:S" & Range("B4").End(xlDown).Row).SpecialCells(xlCellTypeVisible)
  
  For Each c In OneRng
    If c = "" Or c = "(Select One)" Then
    
    cCnt = cCnt + 1
    cc = cc & " " + c.Address(False, False) & ", "
   
    End If
    
  Next
  
   If cCnt > 0 Then
  
     OneRng.Activate
     MsgBox "There are  " & cCnt & " cells with ""Blank"" or ""(Select One)"" in these cell address'." & vbCr & vbCr & cc
     
   Else
   
    MsgBox "All data point are positive."
    Sheets("(Lists)").Visible = True
    Sheets("(Lists)").Activate
   
  End If

  End If

End With

End Sub

 

[L. Howard]

After further study of your workbook, I revised the codes.
(based on my presumptions of how one would operate the worksheet 4. Property Information.)

Let me know if this works for you.

Howard


For the worksheet 4. Property Information module, to chase , & ; (commas and semi-colons).
Restricted to Range("B5:R18") > edit an needed.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("[COLOR=#FF0000]B5:R18[/COLOR]")) 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 was removed from " & Target.Address(False, False)
  
End Sub

In a standard module to check worksheet 4. Property Information entries for completeness and accuracy.

Option Explicit

Sub NextTab_2()
Dim cCnt As Long
Dim OneRng As Range, c As Range
Dim cc As String
Dim myCheck

With ActiveWorkbook.Worksheets("4. Property Information")

Set OneRng = Range("B4:S" & Range("B4").End(xlDown).Row).SpecialCells(xlCellTypeVisible)
    
   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, 2)).Select

      MsgBox "There are  " & cCnt & " cell/s with" & vbCr & _
                    """Blank"" or ""(Select One)""" & vbCr & _
                    "in these cell/s address'." & vbCr & vbCr & Mid(cc, 2)
   Else
   
    myCheck = MsgBox("All data point are positive." & vbCr & _
                     "UNHIDE sheet (List)?", vbYesNo)

    If myCheck = vbNo Then
    
        Exit Sub

    Else
      
      Sheets("(Lists)").Visible = True
      Sheets("(Lists)").Activate

    End If
   
  End If

End With
End Sub

A link to my revision of your worksheet.
See the gold colored right triangle in cell B3 corner to run Sub NextTab_2()
As the sheet is there are three cells with incomplete data and they will be noted and highlighted

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

 

[L. Howard]

Small changes in the two codes (and in the linked workbook).

Discard previous codes.

Howard

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B5:R18")) 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

Sub NextTab_xlDown()
Dim bRow As Long, LRow As Long, cCnt As Long
Dim OneRng As Range, c As Range
Dim cc As String
Dim myCheck
 
With ActiveWorkbook.Worksheets("4. Property Information")

   LRow = .Cells(19, "B").End(xlUp).Row

   Set OneRng = .Range("B4:S" & LRow).SpecialCells(xlCellTypeVisible)

   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 & " cell/s with" & vbCr & _
             """Blank"" or ""(Select One)""" & vbCr & _
             "in these cell/s address'." & vbCr & vbCr & Mid(cc, 2)

   Else

    myCheck = MsgBox("All data point are positive." & vbCr & _
                     "UNHIDE sheet (List)?", vbYesNo)

    If myCheck = vbNo Then
    
        Exit Sub
    Else
      
      Sheets("(Lists)").Visible = True
      Sheets("(Lists)").Activate
    End If
   
  End If
 
End With
End Sub

 

[SanFelippo]

I apologize, I have been out of town until today. I will try and implement the codes and see if they work along with the rest of what I need to put in. Do you still want a breakdown of everything that needs to go into the sheet at some point?

 

[L. Howard]

Here are the code now installed in the linked workbook in my post #17.
All previous codes discard/delete.

In sheet module of 4. Property Information

Private Sub Worksheet_Change(ByVal Target As Range)
If Intersect(Target, Range("B4:R18")) 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

In a standard module.

Option Explicit

Sub NextTab_1X()
Dim bRow As Long, LRow As Long, cCnt As Long
Dim OneRng As Range, c As Range
Dim cc As String
Dim i As Integer, n As Integer
Dim varCols() As Variant

With ActiveWorkbook.Worksheets("4. Property Information")

   For i = 2 To 5
      ReDim Preserve varCols(n)
      varCols(n) = .Cells(18, i).End(xlUp).Row
      n = n + 1
   Next
   
   LRow = Application.Max(varCols)
   Set OneRng = .Range("B4:S" & LRow).SpecialCells(xlCellTypeVisible)
   
   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
      MsgBox "All data point are positive."
      Sheets("(Lists)").Visible = True
      Sheets("(Lists)").Activate
  End If

End With

End Sub

Do you still want a breakdown of everything that needs to go into the sheet at some point?

Not sure what to do with this?? Is the sheet incomplete?

Howard