Scrubbing certain criteria and Highlighting the results

[ChadBD]

Hello Community,

I have spreadsheets sent to me that need to be scrubbed for consistency before they are sent off. My knowledge of VBA code is rudimentary at best. These sheets can contain 2500+ lines of content, the amount is always different but the content needing to be outed is always consistent.

some of the things I am needing to scrub are:
- If a column contains cells in all caps (or just generally making sure if it is 'proper' format or not)
- If a column contains cells that contain special characters
- If there are any duplicates of information within the worksheet (this could mean the whole row or just comparing results in the column, like if there is a duplicate phone number)

Minimally, I need these things highlighted to have the answers stand out. In a perfect situation, having the information that matches the criteria to be relocated to the top of the worksheet.

Only restraint is that all info on a single row needs to stay with one another.

Very new to this community and reaching out to the more knowledgeable than I.
Thank you for taking the time to help with this. It is greatly appreciated!

-Chad

 

[ChadBD]

This looks great! let me give it a try.

 

[ChadBD]

run the scrubber code, the function helps the code and should only be ran from the scrubber macro

Roderick, this works exactly as I am needing it to. I can not thank you enough! Adding the comments so I would know where to throttle each thing was very nice of you as well!

I am really glad to know there is a community out here that can help me and others alike. When it comes to understanding what goes on beyond the hardware of a computer, I am way more of a conceptualizer than a developer. With help like this however, I am able to start grasping some of the more advanced concepts. Kudos!

 

[ChadBD]

While working with it, I changed the

Cells(x, "i").Interior.Color = vbRed
to

Cells(x, "b").Interior.Color = RGB(255, 153, 255)


... If I made a Sheet2 with cells that had the certain highlight colors to use. How could I make it where whatever color was in say 'A1' on Sheet2, be expressed in that line of code?

 

[Roderick_E]

Somewhere immediately after the DIM lines put this

usecolor = sheet2.range("A1").interior.color

Then in the FOR X loop... put this:

[COLOR=#333333]Cells(x, "b").Interior.Color = usecolor[/COLOR]

Obviously you can make multiple colors. Just define as

usecolor1 = sheet2.range("A1").interior.color
usecolor2 = sheet2.range("A2").interior.color
usecolor3 = sheet2.range("A3").interior.color

and so on....

 

[Roderick_E]

Roderick, this works exactly as I am needing it to. I can not thank you enough! Adding the comments so I would know where to throttle each thing was very nice of you as well!

I am really glad to know there is a community out here that can help me and others alike. When it comes to understanding what goes on beyond the hardware of a computer, I am way more of a conceptualizer than a developer. With help like this however, I am able to start grasping some of the more advanced concepts. Kudos!

Well, that was a very nice thank you. Thank much for that. I am a self taught VBA programmer. While my code is sometimes rudimentary, I like it that way because it is easier to understand what's going on and easier for a novice to understand what I'm doing in the code.

 

[ChadBD]

I am getting an error "Next without For' now when I am trying to run the script. It breaks on the line 'Sub scrubber ()'

Below is the code.





Function AlphaNumeric(pValue) As Boolean




Dim LPos As Integer
Dim LChar As String
Dim LValid_Values As String




'Start at first character in pValue
LPos = 1




'Set up values that are considered to be alphanumeric
LValid_Values = " abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ0123456789"




'Test each character in pValue
While LPos <= Len(pValue)




'Single character in pValue
LChar = Mid(pValue, LPos, 1)




'If character is not alphanumeric, return FALSE
If InStr(LValid_Values, LChar) = 0 Then
AlphaNumeric = False
Exit Function
End If




'Increment counter
LPos = LPos + 1




Wend




'Value is alphanumeric, return TRUE
AlphaNumeric = True




End Function


Sub scrubber()
Dim x As Long
Dim lastrow As Long
lastrow = Cells.Find(What:="*", SearchDirection:=xlPrevious, SearchOrder:=xlByRows).Row
For x = 1 To lastrow
usecolor1 = Sheet2.Range("C4").Interior.Color
usecolor2 = Sheet2.Range("C5").Interior.Color
usecolor3 = Sheet2.Range("C6").Interior.Color
usecolor4 = Sheet2.Range("C7").Interior.Color
usecolor5 = Sheet2.Range("C8").Interior.Color




'To change the highlight color, simply change the RGB values. Using values 1 - 255 (R, G, B)


'check col B for propercase
If Cells(x, "b") <> Application.Proper(Cells(x, "b")) Then
Cells(x, "b").Interior.Color = usecolor1
Cells(x, "bd") = "error"
End If
'check col C for non-alpha numeric
If Trim(Cells(x, "c")) <> "" Then
If AlphaNumeric(Cells(x, "c")) = False Then
Cells(x, "c").Interior.Color = usecolor2
Cells(x, "bd") = "error"
'check col C for duplicates
If Application.CountIf(Range("C:C"), Cells(x, "c")) > 1 Then
Cells(x, "c").Interior.Color = usecolor3
Cells(x, "bd") = "error"
End If
End If




'check col I for duplicates
If Trim(Cells(x, "i")) <> "" Then
If Application.CountIf(Range("I:I"), Cells(x, "i")) > 1 Then
Cells(x, "i").Interior.Color = usecolor4
Cells(x, "bd") = "error"
End If
End If
'check col J for duplicates
If Trim(Cells(x, "j")) <> "" Then
If Application.CountIf(Range("J:J"), Cells(x, "j")) > 1 Then
Cells(x, "j").Interior.Color = usecolor5
Cells(x, "bd") = "error"
End If
End If








Next x
End Sub

 

[Roderick_E]

Hi there, first move this set of code OUT of the loop,

[COLOR=#333333]usecolor1 = Sheet2.Range("C4").Interior.Color[/COLOR]
[COLOR=#333333]usecolor2 = Sheet2.Range("C5").Interior.Color[/COLOR]
[COLOR=#333333]usecolor3 = Sheet2.Range("C6").Interior.Color[/COLOR]
[COLOR=#333333]usecolor4 = Sheet2.Range("C7").Interior.Color[/COLOR]
[COLOR=#333333]usecolor5 = Sheet2.Range("C8").Interior.Color[/COLOR]

put it right after the lastrow = blahblahblah line

You need another endif (every If should have an endif)
Place an endif after this block of code:

[COLOR=#333333]If Trim(Cells(x, "c")) <> "" Then[/COLOR]
[COLOR=#333333]If AlphaNumeric(Cells(x, "c")) = False Then[/COLOR]
[COLOR=#333333]Cells(x, "c").Interior.Color = usecolor2[/COLOR]
[COLOR=#333333]Cells(x, "bd") = "error"[/COLOR]
[COLOR=#333333]'check col C for duplicates[/COLOR]
[COLOR=#333333]If Application.CountIf(Range("C:C"), Cells(x, "c")) > 1 Then[/COLOR]
[COLOR=#333333]Cells(x, "c").Interior.Color = usecolor3[/COLOR]
[COLOR=#333333]Cells(x, "bd") = "error"[/COLOR]
[COLOR=#333333]End If[/COLOR]
[COLOR=#333333]End If[/COLOR]

 

[ChadBD]

That fixed it!

Thank you, I will be out of the office until Tuesday. I will be back then. Have a safe holiday!

 

[Roderick_E]

glad to help, take care as well