PDA

View Full Version : [SOLVED] VBA Code to Match US Region to the State that is entered



pawcoyote
01-19-2017, 01:39 PM
Hi,

I am very new to VBA and was wondering if there was a way to do the following.

When entering a State Name in cell Y7 it will put the Region it belongs to in cell AD7

I have a column with States. I am trying to put a VBA formula in another cell to look at that column, if the state is Washington, California, or Oregon, I want the result to be "West". If it's another range of states, it might return "Central", etc.Basically trying to tie state names for which region they are in.

Paul_Hossler
01-19-2017, 01:55 PM
Easiest way is to put


=IFERROR(VLOOKUP(Y7,States!$A:$B,2,FALSE),"Not Found")

in AD7, and use a 'data base' sheet like in the attachment (named 'States')

Or were you looking for something more complicated?

pawcoyote
01-20-2017, 08:13 AM
Easiest way is to put


=IFERROR(VLOOKUP(Y7,States!$A:$B,2,FALSE),"Not Found")

in AD7, and use a 'data base' sheet like in the attachment (named 'States')

Or were you looking for something more complicated?

Thank you I will try this...

pawcoyote
01-23-2017, 07:49 AM
Easiest way is to put


=IFERROR(VLOOKUP(Y7,States!$A:$B,2,FALSE),"Not Found")

in AD7, and use a 'data base' sheet like in the attachment (named 'States')

Or were you looking for something more complicated?

Hi Paul, that is what I want to do thanks. IT works great, now how would I put that into a VBA script to run automatically when I enter a State into A3 and so on?

mike7952
01-23-2017, 08:15 AM
Using Pauls uploaded workbook add the states to column A on the Example sheet and run macro


Sub abc()
Dim i As Long
Dim rng As Range, cell As Range
With Worksheets("states")
arr = .Range("a1").CurrentRegion.Value
End With
With Worksheets("Example")
Set rng = .Range("a1", Cells(Rows.Count, "a").End(xlUp))
End With
With CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
.Item(arr(i, 1)) = arr(i, 2)
Next
For Each cell In rng
If .exists(cell.Value) Then
cell.Offset(, 1) = .Item(cell.Value)
Else
cell.Offset(, 1) = "Not Found"
End If
Next
End With
End Sub

See attached workbook: 18103

Paul_Hossler
01-23-2017, 08:33 AM
It can be done using Worksheet Events, but you'll need to be a little more specific as to cells

E.g. in #1 you said state in Y7 and region in AD7

In #4 you said state in A3

I'd need to know the cells where you might put a state and the cells where the region goes

pawcoyote
01-23-2017, 08:39 AM
Using Pauls uploaded workbook add the states to column A on the Example sheet and run macro


Sub abc()
Dim i As Long
Dim rng As Range, cell As Range
With Worksheets("states")
arr = .Range("a1").CurrentRegion.Value
End With
With Worksheets("Example")
Set rng = .Range("a1", Cells(Rows.Count, "a").End(xlUp))
End With
With CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
.Item(arr(i, 1)) = arr(i, 2)
Next
For Each cell In rng
If .exists(cell.Value) Then
cell.Offset(, 1) = .Item(cell.Value)
Else
cell.Offset(, 1) = "Not Found"
End If
Next
End With
End Sub

See attached workbook: 18103

Hi, I have been modifying my Worksheets with the info provided. Here is what I have and doing...

Worksheet MDS Equipment Detail Column Y7 is the first cell to key in a State. Column AD7 is where I want the matching Region to go.

Worksheet Names: I have all my look up values there, I have created Named Ranges for each State and Region as listed below.

names_state {...} =OFFSET(Names!$J$2,0,0,COUNTA(Names!$J$2:$J$200),1)
names_region {...} =OFFSET(Names!$L$2,0,0,COUNTA(Names!$K$2:$K$100),1)

If you want to look at the spreadsheet let me know...

mike7952
01-23-2017, 08:45 AM
If you want to look at the spreadsheet let me know...

Yes that would be great

pawcoyote
01-23-2017, 08:57 AM
Here is the sample file with the two worksheets on it and the data...

mike7952
01-23-2017, 09:23 AM
Try this


Private Sub Worksheet_Change(ByVal Target As Range)
Const Column_Y As Long = 25
If Target.Column = Column_Y Then
Target.Offset(, 5) = Evaluate("=IFNA(INDEX(Names!K:K,MATCH(""" & Target.Value & """,Names!J:J,0)),""Not Found"")")
End If
End Sub

pawcoyote
01-23-2017, 09:36 AM
I will test it out thank you!

mike7952
01-23-2017, 09:44 AM
I will test it out thank you!


Add the code to the MDS Equipment Detail worksheet module

pawcoyote
01-23-2017, 10:09 AM
I have added the code to the worksheet view code worksheet area. But it isn't working. Nothing is populating Field AD on the MDS Equipment Detail sheet.

18106

Paul_Hossler
01-23-2017, 10:26 AM
I'd add a little more to it

1. You need Application.EnableEvents = False to prevent the event handler for triggering itself

2. It is possible that multiple col Y cells are changed at once (Paste, Control-Enter, etc.) so you would need to handle each one

3. If it's not found, then I just made the Region Red, although you could make the bad state red also

4. You could use Data Validation to make a drop down list since it's easy to misspell/mistype something

5. You could allow a state abbreviation in col Y, do the region lookup and also replace the NY with 'New York'




Option Explicit

Const cStateCol As Long = 25
Const cRegionCol As Long = 30

Dim rNames As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rStates As Range, rState As Range
Dim v As Variant

If Intersect(Target, Me.Columns(cStateCol)) Is Nothing Then Exit Sub

Set rStates = Intersect(Target, Me.Columns(cStateCol))
Set rNames = Worksheets("Names").Range("J:K")

Application.EnableEvents = False

For Each rState In rStates.Cells
With rState
If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

Else
On Error Resume Next
v = Application.WorksheetFunction.VLookup(.Value, rNames, 2, False)
On Error GoTo 0

If IsEmpty(v) Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = vbRed
Else
.EntireRow.Cells(cRegionCol).Value = v
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone
End If
End If
End With
Next

Application.EnableEvents = True
End Sub

pawcoyote
01-23-2017, 10:42 AM
I'd add a little more to it

1. You need Application.EnableEvents = False to prevent the event handler for triggering itself

2. It is possible that multiple col Y cells are changed at once (Paste, Control-Enter, etc.) so you would need to handle each one

3. If it's not found, then I just made the Region Red, although you could make the bad state red also

4. You could use Data Validation to make a drop down list since it's easy to misspell/mistype something

5. You could allow a state abbreviation in col Y, do the region lookup and also replace the NY with 'New York'




Option Explicit

Const cStateCol As Long = 25
Const cRegionCol As Long = 30

Dim rNames As Range

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rStates As Range, rState As Range
Dim v As Variant

If Intersect(Target, Me.Columns(cStateCol)) Is Nothing Then Exit Sub

Set rStates = Intersect(Target, Me.Columns(cStateCol))
Set rNames = Worksheets("Names").Range("J:K")

Application.EnableEvents = False

For Each rState In rStates.Cells
With rState
If Len(Trim(rState.Value)) = 0 Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone

Else
On Error Resume Next
v = Application.WorksheetFunction.VLookup(.Value, rNames, 2, False)
On Error GoTo 0

If IsEmpty(v) Then
.EntireRow.Cells(cRegionCol).ClearContents
.EntireRow.Cells(cRegionCol).Interior.Color = vbRed
Else
.EntireRow.Cells(cRegionCol).Value = v
.EntireRow.Cells(cRegionCol).Interior.Color = xlNone
End If
End If
End With
Next

Application.EnableEvents = True
End Sub



Hi, I do have a Data Validation being used on the State Field. All State Names are on the Names Sheet Column K and have a =OFFSET COUNTA enabled on them as well.

Paul_Hossler
01-23-2017, 10:48 AM
Not the Data Validation I meant

18112


18113

pawcoyote
01-23-2017, 11:06 AM
Not the Data Validation I meant

18112


18113

Correct... It all works on the Sample sheet you sent back. Looks great and does what I want. I added in the Data Validation like I did on my other sheet and it works... but when I copy the code to my other workbook and sheet "View Code" "Worksheet "Change" like on the Sample Doc, nothing happens when I change the State field.

18114

Paul_Hossler
01-23-2017, 11:33 AM
Hard to tell from your picture


1. Double check your addresses

State in in Col Y, and the lookup table in in Names J:K

2. Make sure that you're not disabling Events someplace else

Put a break point on the first line in the event handler, enter a state, and make sure the event handler is called

Single step through the handler and see what's happening

18115

pawcoyote
01-23-2017, 12:22 PM
Thank you, I am redoing the Workbook. I have had a lot of trial by error's on that one. I am going to create a master and only put in the working VBA, Formulas and Macro's. Everyone has been a huge help to me and I am very appreciative of it. I am a very new to VBA and trying to under stand it all as I go.

Again thank you and I will post back once I get it cleaned up and working.

pawcoyote
01-24-2017, 10:53 AM
I updated a new sheet and the code works thank you so much for all your help.

pawcoyote
01-26-2017, 12:18 PM
Hi Paul, I am trying to add more to this sheet... What I want to do is Color specific Required Columns Yellow on the MDS Equipment Detail sheet if they are missing info if the first Cell B7 has data entered. I want to keep it in line with the code you already helped me with. Using the specific headers for the required cells. Mfg, Model Name, Model, Serial Number, Equipment ID etc.. I will add more as I want to make them required. I also want to Color the cells in the following Columns on the MDS Equipment Detail sheet Pink if they are Duplicates: Serial Number, Equipment ID, IP Address, Host Name, Oracle Config SN and MAC Address.

Paul_Hossler
01-26-2017, 03:17 PM
Play around with this version

pawcoyote
01-26-2017, 04:53 PM
Will do, I used conditions but would like to see how to do it in vba.. Thanks

pawcoyote
01-27-2017, 09:29 AM
I am looking at it and will post if I have questions. Thanks... I will be having a question in a few on how to look up across multiple spreadsheets and then pull in information from those sheets to one sheet... I will have more details once I get it all put down in my head..
Play around with this version

pawcoyote
01-27-2017, 10:05 AM
Hi, a couple of things, the color coding doesn't seem to work unless you exit and enter the MDS tab. Then the color coding doesn't work properly all the time. It seems to work some times and not other. I also have Equipment ID's that are showing as dupes but they arn't. It also doesn't seem to fill in the color unless I change something in another cell..

Also if I clean up one of the dupes it keeps one of them still color coded as being a dupe even though it isn't..


Play around with this version

pawcoyote
01-27-2017, 12:28 PM
I was able to add in more item for required as well as change to color of the cells... I am having this issue, it seems that I have to exit the Worksheet and go back in for the script to run properly. I cannot just open the book to the that worksheet and start typing and have the color coding work. Also on Dupes when I fix a dupe it doesn't reset to no color for the cell I didn't have to fix for the dupes it still shows as a dupe...

Paul_Hossler
01-27-2017, 01:43 PM
It's only the cell(s) that change that drive the condition testing, just like it was only the state that changed that drove the region field populating

The color coding is tied into the WS change event and works on the single row of the cell(s) that changed (client requires C-G values) or on the single column of the cell(s) that changed (no dup on SN, etc.)


1. You used the worksheet_activate event to show your userform so I just included the column number determination in that so it only needs to run once per ws activation

2. The column number of the cell(s) that changed determines the checks that are made (I did forget the Model column in ver 10)

a. If Client (B:B) changes then C:G are checked to see if they're blank in that row

b. If C thru G change, then

if Client is blank then clear color in that row for that cell

if client is not blank, then if the changed cell is blank, make it red else clear color in that row for that cell

3. If a cell in a no dups column is change, then check the column for dups in that column


I could easily check every cell for every condition for every change, but that will add user time by checking cells that were not changed

I could add a sub to check every condition


Either is easy

Do this -- clear the color on all the data rows and make changes (I did not see any unmarked dups)

Make changes and let me know

18174

Paul_Hossler
01-27-2017, 02:31 PM
This is a little slower and brute force

EVERY change to MDS causes ALL the checks to be reapplied to ALL cells, including the original requirement to translate State to Region

pawcoyote
01-28-2017, 11:56 AM
I will check out both, I appreciate all your help.
This is a little slower and brute force

EVERY change to MDS causes ALL the checks to be reapplied to ALL cells, including the original requirement to translate State to Region

Paul_Hossler
01-28-2017, 12:58 PM
I'm guessing that you'll prefer ver 12, even though it's a little slower

pawcoyote
01-30-2017, 06:48 AM
Hi, I am still not able to see how the cells clear the fill in color once you have fixed the issue. They still stay either Red or Violet. The Duples are checked by the Columns that the data is keyed into. The missing required information is based off the the initial entry of the Client Name and should change to no color as we progress through the sheet. I would like it not to be triggered only when you enter the worksheet for the first time but instantaneously anytime you are on that sheet and working. If there is an easier way to have the legend popup I am game for that as well. I am also looking into how I can have it show again by a short cut key but that is later... I don't want to have to exit and enter the sheet each time to have it do validation checks and or run anything. Does that make sense?

Sample 11 the changing of Colors worked with the exception of the Dupe check it would clear the color of the one you fixed but leave the other one as still showing as a dupe.

Sample 12 none of the colors change..


I'm guessing that you'll prefer ver 12, even though it's a little slower

Paul_Hossler
01-30-2017, 07:36 AM
I missed a check

Try ver 13

pawcoyote
01-30-2017, 08:13 AM
Testing it out. I did notice the following code
.EntireRow.Cells(colRegion).Interior.Color = vbRed It is not coloring the Region field when empty.. If that is suppose to do that.. Also How can I change the Color of the Cell to be a ColorIndex and the Font to a different Color and then revert back to the default of no fill and auto font?
I missed a check

Try ver 13

Paul_Hossler
01-30-2017, 11:02 AM
A blank Region was not on the original list since it was populated by entering a state (your very first request)

I marked a blank state and region now

You wanted dups marked in pink, do you mean that to want to enter the color index? I put two Const at the top so you can change

18186

pawcoyote
01-30-2017, 11:20 AM
Hi, No I noticed the code in the VBA area to color it red and was wondering what it meant. I have added in a bunch of other Required columns into the VBA area copying what you started but I am getting errors when it runs. I have uploaded the Sample 15 I like the color indexes better since they allow for more colors to be used.. Not sure what I did wrong on the code...

What I was looking for in colors are as such..

Duplicates ColorIndex = 38 fill and 9 Text on Duplicates found.. Default when fixed or no duplicates

Required Fields Colorindex = 36 fill and Text Default

I had found how to make those changes in your Sample 13 but when I tried to add more Required fields into the code it threw errors..


A blank Region was not on the original list since it was populated by entering a state (your very first request)

I marked a blank state and region now

You wanted dups marked in pink, do you mean that to want to enter the color index? I put two Const at the top so you can change

18186

Paul_Hossler
01-30-2017, 01:28 PM
You had some typos on the column headers your were matching (I marked them in the macro)

I decided that since there seems like there will be a changes to your column headers add a ColHeaderNumber function that will tell you what the missing column header is

Anyway, here's ver 16 for you to check out

pawcoyote
01-30-2017, 01:58 PM
Thank you, The color coding works great, but the Region Filling in or deleting when you enter the state and the Oracle Site Reference filling in or removing does not work...
You had some typos on the column headers your were matching (I marked them in the macro)

I decided that since there seems like there will be a changes to your column headers add a ColHeaderNumber function that will tell you what the missing column header is

Anyway, here's ver 16 for you to check out

Paul_Hossler
01-30-2017, 02:39 PM
I added the .Offset line to clear the rest of the line if Client is blank like in Line 7



' ------------------------------------------- client
For Each rCell In rData.Columns(colClient).Cells
With rCell
If Len(.Value) = 0 Then
.EntireRow.Interior.Color = xlNone
.EntireRow.Font.ColorIndex = xlColorIndexAutomatic
.Offset(0, 1).Resize(1, .Parent.Columns.Count - 2).ClearContents
End If
End With
Next



Clearing and entering a State seems to clear the Region and Oracle fields like in line2

18193

Any more details?

pawcoyote
01-30-2017, 04:22 PM
Thanks, I found it I fat fingered something once again... I will be looking at everything. I do want to work more on this and add onto it if that is okay... I love what you are helping me with..
I added the .Offset line to clear the rest of the line if Client is blank like in Line 7



' ------------------------------------------- client
For Each rCell In rData.Columns(colClient).Cells
With rCell
If Len(.Value) = 0 Then
.EntireRow.Interior.Color = xlNone
.EntireRow.Font.ColorIndex = xlColorIndexAutomatic
.Offset(0, 1).Resize(1, .Parent.Columns.Count - 2).ClearContents
End If
End With
Next



Clearing and entering a State seems to clear the Region and Oracle fields like in line2

18193

Any more details?

pawcoyote
02-01-2017, 01:56 PM
Hi, I noticed if I clear the Client Name it removes everything from every cell in that row. Is there a way to not do that?
I added the .Offset line to clear the rest of the line if Client is blank like in Line 7



' ------------------------------------------- client
For Each rCell In rData.Columns(colClient).Cells
With rCell
If Len(.Value) = 0 Then
.EntireRow.Interior.Color = xlNone
.EntireRow.Font.ColorIndex = xlColorIndexAutomatic
.Offset(0, 1).Resize(1, .Parent.Columns.Count - 2).ClearContents
End If
End With
Next



Clearing and entering a State seems to clear the Region and Oracle fields like in line2

18193

Any more details?

Paul_Hossler
02-01-2017, 05:16 PM
I added the .Offset line to clear the rest of the line if Client is blank like in Line 7


Remove this line



.Offset(0, 1).Resize(1, .Parent.Columns.Count - 2).ClearContents

pawcoyote
02-02-2017, 07:24 AM
Thank you I will look at that. I am also working on a new sheet that I will want to copy information from the MDS sheet into I am going to add it to a sample and post once done...
Remove this line



.Offset(0, 1).Resize(1, .Parent.Columns.Count - 2).ClearContents

pawcoyote
02-08-2017, 03:06 PM
Hi, I have an add on to this now. I have included a new worksheet called MOST. I need to copy specific fields from the "MDS Equipment Detail Worksheet and put them into the MOST worksheet. On the MOST worksheet I have put the Headers from the MDS worksheet and their column letter so you can see what I am trying to copy over. I would like this set as a macro (button) that I can click once I have all the data keyed in properly on the MDS worksheet.

Thank you for any help.

Please see Sample Workbook_18

Paul_Hossler
02-08-2017, 04:42 PM
Try this

You might need to tweak it

pawcoyote
02-09-2017, 07:39 AM
Thank you very much I will be looking it over and again thank you for all your help.


Try this

You might need to tweak it

pawcoyote
02-09-2017, 07:51 AM
Hi,

If I wanted to use the Column Headers for reference on the MOST and MDS worksheet instead of the Column Number do I substitute the number i.e. 1 with the Header name i.e. "Oracle Project Code" on the MDS worksheet and "Project Number" on the MOST worksheet?


wsMOST.Cells(i - 1, "Project Number").Value = .Cells(i, "Oracle Project Code").Value

Additional Question: Why do I get the following when I go to look at my macro's
'Sample Workbook_19.xlsm'!VersionNotes.VersionNotes


Try this

You might need to tweak it

Paul_Hossler
02-12-2017, 07:16 PM
1. I added new sub LUV to return the n-th row bu searching the col headers row to find the column string each time


I added error message to help figure out what was wrong with the column header

I would have been a LOT easier if the column headers in MDS and MOST were called the same






Option Explicit

'Look Up value
Function LUV(rColHeaders As Range, sColHeader As String, N As Long) As Range
Dim i As Long

i = 0

On Error Resume Next
i = Application.WorksheetFunction.Match(sColHeader, rColHeaders, 0)
On Error GoTo 0

If i <> 0 Then
Set LUV = rColHeaders.Parent.Cells(N, i)
Else
MsgBox "Column " & sColHeader & " not found in row " & rColHeaders.Address & " on worksheet " & rColHeaders.Parent.Name
End If
End Function
Function GetColumnNumber(sColHeader As String, rColHeaders As Range) As Long
Dim i As Long
i = 0

On Error Resume Next
i = Application.WorksheetFunction.Match(sColHeader, rColHeaders, 0)
On Error GoTo 0

If i <> 0 Then
GetColumnNumber = i
Else
MsgBox "Column " & sColHeader & " not found in row " & rColHeaders.Address & " on worksheet " & rColHeaders.Parent.Name
End If
End Function





Additional Question: Why do I get the following when I go to look at my macro's

Probably because you had 2 workbooks open with the same sheet names and macro names

pawcoyote
02-13-2017, 06:58 AM
Thank you I will be working on this today. I have a quick question for you. I keep getting the following Sheet added to my workbook and I don't know why. It is a Very Hidden worksheet.


1. I added new sub LUV to return the n-th row bu searching the col headers row to find the column string each time It goes down 412 Rows and out to Column IV. I had to remove some of the rows to make the file size fit for upload.


I added error message to help figure out what was wrong with the column header

I would have been a LOT easier if the column headers in MDS and MOST were called the same






Option Explicit

'Look Up value
Function LUV(rColHeaders As Range, sColHeader As String, N As Long) As Range
Dim i As Long

i = 0

On Error Resume Next
i = Application.WorksheetFunction.Match(sColHeader, rColHeaders, 0)
On Error GoTo 0

If i <> 0 Then
Set LUV = rColHeaders.Parent.Cells(N, i)
Else
MsgBox "Column " & sColHeader & " not found in row " & rColHeaders.Address & " on worksheet " & rColHeaders.Parent.Name
End If
End Function
Function GetColumnNumber(sColHeader As String, rColHeaders As Range) As Long
Dim i As Long
i = 0

On Error Resume Next
i = Application.WorksheetFunction.Match(sColHeader, rColHeaders, 0)
On Error GoTo 0

If i <> 0 Then
GetColumnNumber = i
Else
MsgBox "Column " & sColHeader & " not found in row " & rColHeaders.Address & " on worksheet " & rColHeaders.Parent.Name
End If
End Function






Probably because you had 2 workbooks open with the same sheet names and macro names

Paul_Hossler
02-13-2017, 08:14 AM
No idea why that sheet is being added

Ver 20 does not have it, so it must be something in your real workbook

It references another workbook if that helps

18351

pawcoyote
02-13-2017, 09:55 AM
Thank you, I will look at what I might have put in...

pawcoyote
02-13-2017, 10:21 AM
Hi,

I no longer get the Regions populated when a State is added nor is the Oracle Site Reference being added. I have added version 21 with changes I have made so you can see what I have done so far. Quick note on the error, could JIVE be causing that to happen?
1. I added new sub LUV to return the n-th row bu searching the col headers row to find the column string each time


I added error message to help figure out what was wrong with the column header

I would have been a LOT easier if the column headers in MDS and MOST were called the same






Option Explicit

'Look Up value
Function LUV(rColHeaders As Range, sColHeader As String, N As Long) As Range
Dim i As Long

i = 0

On Error Resume Next
i = Application.WorksheetFunction.Match(sColHeader, rColHeaders, 0)
On Error GoTo 0

If i <> 0 Then
Set LUV = rColHeaders.Parent.Cells(N, i)
Else
MsgBox "Column " & sColHeader & " not found in row " & rColHeaders.Address & " on worksheet " & rColHeaders.Parent.Name
End If
End Function
Function GetColumnNumber(sColHeader As String, rColHeaders As Range) As Long
Dim i As Long
i = 0

On Error Resume Next
i = Application.WorksheetFunction.Match(sColHeader, rColHeaders, 0)
On Error GoTo 0

If i <> 0 Then
GetColumnNumber = i
Else
MsgBox "Column " & sColHeader & " not found in row " & rColHeaders.Address & " on worksheet " & rColHeaders.Parent.Name
End If
End Function






Probably because you had 2 workbooks open with the same sheet names and macro names

Paul_Hossler
02-13-2017, 10:59 AM
When I changed it to use column headers instead of column numbers, I had a couple wrong

pawcoyote
02-13-2017, 11:26 AM
That would have been on the MDS module correct? I want to be sure I am looking at the right mod for fixes.

Paul_Hossler
02-13-2017, 12:31 PM
Yes

The way I made the LUV() function it takes the col header string so look in that area

pawcoyote
02-23-2017, 10:39 AM
Hi, I would like to protect the workbook/worksheets once we are done with the coding. But when I do the VBA and Macro's do not run properly. Also I am seeing that the VBA isn't running in excel 2010. I built this on excel 2007. Any suggestions?
Yes

The way I made the LUV() function it takes the col header string so look in that area

pawcoyote
02-24-2017, 07:10 AM
I found out what is doing it but not sure why. I use Jive and every time I post the workbook using jive it adds this hidden worksheet. Still looking for a fix..
No idea why that sheet is being added

Ver 20 does not have it, so it must be something in your real workbook

It references another workbook if that helps

18351

Paul_Hossler
02-24-2017, 01:05 PM
Don't know what Jive is, but maybe don't use it

To allow some cells to be updated when the sheet is protected, you need to make .Locked = False




Option Explicit

Sub ProtectMDS()
With Worksheets("MDS Equipment Detail")
If .ProtectContents Then Exit Sub
Range(.Rows(1), .Rows(6)).Locked = True
Range(.Rows(7), .Rows(.Rows.Count)).Locked = False
.Protect Password:="password", UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowDeletingRows:=True, AllowFiltering:=True
End With
End Sub


Sub UnProtectMDS()
With Worksheets("MDS Equipment Detail")
If Not .ProtectContents Then Exit Sub
.Unprotect Password:="password"
End With
End Sub

pawcoyote
02-25-2017, 11:14 AM
Hi, I added the code to the MDS Equipment Detail Sheet in VBA but I keep getting an error once I protect the sheet.

I need to unprotect the following when we enter the MDS Equipment Detail sheet. Allowing all VBA and Macros to run...

Row 5 & 6 Certain Headers Columns CA - CL (I want to be able to change the names of the headers as needed

Row 7 and on all fields to be open for running VBA and Macros..

I am also looking to only copy the information from the MDS Equipment Detail Sheet to the MOST Add Sheet when a Client Name is filled in the Client Name column otherwise do not copy those rows..

When I protect the MDS Equipment Detail sheet this is where the error goes too..

With rMDS
.Interior.Color = xlNone





Don't know what Jive is, but maybe don't use it

To allow some cells to be updated when the sheet is protected, you need to make .Locked = False




Option Explicit

Sub ProtectMDS()
With Worksheets("MDS Equipment Detail")
If .ProtectContents Then Exit Sub
Range(.Rows(1), .Rows(6)).Locked = True
Range(.Rows(7), .Rows(.Rows.Count)).Locked = False
.Protect Password:="password", UserInterfaceOnly:=True, DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, AllowDeletingRows:=True, AllowFiltering:=True
End With
End Sub


Sub UnProtectMDS()
With Worksheets("MDS Equipment Detail")
If Not .ProtectContents Then Exit Sub
.Unprotect Password:="password"
End With
End Sub

Paul_Hossler
02-25-2017, 12:44 PM
1. I put the protect subs on mod_Util since you have to run them manually and added the CA-CL write capability, marked with <<< below so that you can change it



Sub ProtectMDS()

With Worksheets("MDS Equipment Detail")
If .ProtectContents Then Exit Sub
Range(.Rows(1), .Rows(6)).Locked = True
Range("CA5").Resize(2, 16).Locked = False '<<<<<<<<<<<<<<<<<<<
Range(.Rows(7), .Rows(.Rows.Count)).Locked = False
.Protect Password:="password", UserInterfaceOnly:=True, _
DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, _
AllowDeletingRows:=True, AllowFiltering:=True
.EnableSelection = xlUnlockedCells
End With
End Sub


Sub UnProtectMDS()
With Worksheets("MDS Equipment Detail")
If Not .ProtectContents Then Exit Sub
.Unprotect Password:="password"
End With
End Sub



2. You must have changed the layout of MOST so the header row was wrong



Public Const rowHeaderMOST As Long = 4
Public Const rowDataStartMOST As Long = 5



3. I changed the logic to not use the UsedRange on MDS but only down to the last row that has a Client

pawcoyote
02-25-2017, 12:53 PM
Yes sorry I did add another Header in Column B.

pawcoyote
02-25-2017, 01:01 PM
Hi,

I found a funky thing... When I remove the Client Name it doesn't remove the color coding of the fields for required information.
1. I put the protect subs on mod_Util since you have to run them manually and added the CA-CL write capability, marked with <<< below so that you can change it



Sub ProtectMDS()

With Worksheets("MDS Equipment Detail")
If .ProtectContents Then Exit Sub
Range(.Rows(1), .Rows(6)).Locked = True
Range("CA5").Resize(2, 16).Locked = False '<<<<<<<<<<<<<<<<<<<
Range(.Rows(7), .Rows(.Rows.Count)).Locked = False
.Protect Password:="password", UserInterfaceOnly:=True, _
DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFormattingCells:=True, _
AllowDeletingRows:=True, AllowFiltering:=True
.EnableSelection = xlUnlockedCells
End With
End Sub


Sub UnProtectMDS()
With Worksheets("MDS Equipment Detail")
If Not .ProtectContents Then Exit Sub
.Unprotect Password:="password"
End With
End Sub



2. You must have changed the layout of MOST so the header row was wrong



Public Const rowHeaderMOST As Long = 4
Public Const rowDataStartMOST As Long = 5



3. I changed the logic to not use the UsedRange on MDS but only down to the last row that has a Client

Paul_Hossler
02-25-2017, 01:38 PM
I think it clears the 'Required Data' except if the last client was the one deleted