Hi I need to check all data in column for spellings and abbreviation.
Here's my code:
Sub ColorMispelledCells()
For Each cl In ActiveSheet.UsedRange
If Not Application.CheckSpelling(Word:=cl.Text) Then _
cl.Interior.ColorIndex = 28
Next cl
End Sub
Anyway I can alter this to make it a column based checking and not cell and not hightlight the cell but instead add a note to the next column that the word is wrong spelling or abbreviated?
You would change the loop to a for loop to go through a single column. You would need to do more specifics for what the message should be, if it's spelling, abbreviated, etc.
Dim i as Long, j as Long, LR as Long
j = 1 'Setting this up for Column A, aka Column 1
LR = Cells( Rows.Count, j).End(xlUp).Row 'Assumes contiguous column j
For i = 1 to LR
If Application.CheckSpelling(word:=Cells(i,j).Value)=False Then
Cells(i,j+1).Value = "SpellCheck Error!"
End If
Next i
First, change your routine that is works with any Range.
Sub ColorMispelledCells(r As Range)
Dim c As Range
For Each c In r
if VarType(c.value2) = vbString then
If Not Application.CheckSpelling(c.Value2) Then
c.Interior.ColorIndex = 28
Else
c.Interior.ColorIndex = 0
End If
End If
Next
End Sub
Variant, not coloring but write a text in the cell to the right - but note that this will overwrite whatever content is in that cell.
c.Offset(0, 1) = "You have misspelled something..."
Then, add a sub for the button - this will spell check all cells in use (but note that this may take quite some time.
sub ButtonPressed()
ColorMispelledCells(activesheet.usedRange)
end sub
Related
This question already has answers here:
Excel VBA - Delete empty rows
(9 answers)
Closed 5 years ago.
I checked the search function, but could not find any answer to my issue.
What I want is VBA to check a specific range for 200+ rows whether these are entirely empty and if so, to delete these and shift up cells.
Sub delete_empty_cells2()
Dim k As Integer
Dim r As Range
For k = 4 To 260
Set r = Range("AAk:AFk")
If r.Value = "" Then
r.Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.Delete Shift:=xlUp
End If
Next k
End Sub
Now obviously, the code is wrong. I'm not really used to VBA yet and don't know all commands / objects. Is there a way to tell VBA that the range is variable (it should check all ranges, e.g. starting by checking AA4:AF4).
Thanks in advance!
Zahbi
You should go backwards in your loop and look at the code below to see how to use k variable accordingly. If you loop forwards, when you delete a row, you should decrease this number from your loop variable and it is a lot of work, plus confusing.
Try this:
Sub delete_empty_cells2()
Dim k As Long
Dim r As Range
For k = 260 To 4 Step -1
Set r = Range("AA" & k & ":AF" & k)
If Application.WorksheetFunction.CountA(r) = 0 Then
Rows(k).EntireRow.Delete
End If
Next k
End Sub
Here's one way to do it. You don't actually have to delete anything until right at the end -- it's much quicker.
Sub delete_empty_cells2()
Dim rng As Range, fullRow As Range, populatedRange As Range, emptyRange As Range
Set rng = Sheet1.Range("AA4:AF260")
For Each fullRow In rng.Rows
Set populatedRange = fullRow.Find("*")
If populatedRange Is Nothing Then
If emptyRange Is Nothing Then
Set emptyRange = fullRow
Else
Set emptyRange = Union(emptyRange, fullRow)
End If
End If
Next fullRow
If Not emptyRange Is Nothing Then emptyRange.Delete
End Sub
I have a workbook that is never received in the same format. To prevent manual intervention, I need to capture the Column that the text employee is in. For example, if the text is in column O - I would execute the below, but I would need the Cells(i,"O") to be changed based off the cell that contains the text employee
Sub DoThis()
Application.ScreenUpdating = False
Dim i As Long
For i = Range("A" & Rows.Count).End(3).Row To 2 Step -1
If Not IsEmpty(Cells(i, "O").Value) Then
'stuff here
End If
Next i
End Sub
You can use the Find method and get the column of the cell that employee is found in to use in Cells :
Option Explicit
Sub DoThis()
Dim i As Long
Dim lngCol As Long
With Worksheets("Sheet1") '<-- change to your sheet
lngCol = .Rows(1).Find("employee").Column '<-- assumes header in Row 1
For i = .Range("A" & .Rows.Count).End(3).Row To 2 Step -1
If Not IsEmpty(.Cells(i, lngCol).Value) Then
'stuff here
End If
Next i
End With
End Sub
Use the find method
Cells.Find("employee")
This will find the cell in the range specified (here I've used Cells but I'd narrow this down to your range) and it will return the cell that contains the text "employee". You can then reference this as a Range object i.e. use .Row to get the row number or .Column to get the column number
I am hoping someone here can help me. I am trying to create a macro that looks at a cell in one sheet to see if that cell has a formula or not. If it has a formula it inputs a 1 in the same cell on a different sheet, if not it inputs a 0. This is what I have so far but it is giving me a compile error: Next without for.
Sub FormulaMap()
Dim r As Integer
Dim c As Integer
For c = 9 To 17
For r = 11 To 18
If Sheets("Data").Cells(c & r).HasFormula = True Then
Sheets("Map").Cells(c & r).Value = 1
Else: Sheets("Map").Cells(c & r).Value = 0
Next r
Next c
End Sub
Any help is appreciated.
As mentioned by #Nathan_Sav you need to add End If before calling the next r and c, you also need to use a comma to separate the c and r in the Cells function. I'm also assuming that c is a column reference and r is a row reference? Try this:
Sub FormulaMap()
Dim r As Long
Dim c As Long
For c = 9 To 17
For r = 11 To 18
If Sheets("Data").Cells(r, c).HasFormula Then
Sheets("Map").Cells(r, c).Value = 1
Else
Sheets("Map").Cells(r, c).Value = 0
End If
Next r
Next c
End Sub
Also note that the VBA Integer type only ranges from -32,768 to 32,767. This is why it's recommended to use Long (–2,147,483,648 to 2,147,483,647) especially when going through rows.
One thing is what Nathan_Sav said, but second thing is that you have to change your Cells statements so there are two arguments inside. The proper way to call it is
Cells(row, column)
So in your code it would be
Cells(r, c)
(if r means row and c - column)
Your code should be
For c = 9 To 17
For r = 11 To 18
If Sheets("Data").Cells(c, r).HasFormula = True Then
Sheets("Map").Cells(c, r).Value = 1
Else
Sheets("Map").Cells(c, r).Value = 0
End If
Next r
Next c
You have no End If at the end of your If Then Else.
As an alternative, you could try this method...
You can pass in different ranges...
Option Explicit
Public Sub Test()
Dim ws As Worksheet 'Reference the Map sheet
Dim rData As Range 'Reference the actual range
Set ws = Worksheets("Map")
Set rData = Sheets("Data").Range("I11:Q18") 'Can be any range.
'Do the call..
Call EnumFormulas(rData, ws)
End Sub
Public Sub EnumFormulas(ByVal SourceData As Range, ByVal Destination As Worksheet)
Dim rFoundFormulas As Range, rPtr As Range
'Fill all data to 0's
Destination.Range(SourceData.Address).Value = 0
On Error Resume Next
Set rFoundFormulas = SourceData.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rFoundFormulas Is Nothing Then
For Each rPtr In rFoundFormulas
Destination.Range(rPtr.Address).Value = 1 'Fill in 1 cell.
Next
End If
End Sub
So I have data with around 20,000 records. I want to set the range such that only data from Row 2 to 20,000 is checked in column A. However, cell 20,001 isn't blank, it could contain spaces as well.
(This data is imported prior to validation, so I cannot alter it)
When I use .End(xlUp) it ends up checking till some 50,000th row.
Any Help?
Sample:
Column A
A
B
(2 spaces inserted)
I want to check for cells only till B(including it)
Update:
Managed to return the last required cell to the main sub
Private Sub last()
Dim rngX As Range
Set rngX = ActiveSheet.Range("A1").EntireColumn.Find(" ", lookat:=xlPart)
If Not rngX Is Nothing Then
/* return value
End If
End Sub
GD pnuts,
If you want to use VBA, you could contemplate checking for [space] character ? assuming the cell contains only spaces (or only one for that matter)
Something like:
Dim r as range
set r = range("B")
For each c in r.rows
if instr(1, c.value,chr(32)) > 0 then
'do something
end if
next
You could function a check of all characters in cell.value string to validate that they are only spaces ?
Does that help ?
I believe you will have to test each cell individually. To make the number of cells to check smaller, and to speed things up, I would first read the column to check into a Variant array, and then check that from bottom to top. I the spaces are truly a space, the test below will work. If the space is a NBSP, or a combination, then you will have to revise the check to ensure that is the only thing present.
e.g: to check column A:
Option Explicit
Sub foo()
Dim R As Range
Dim WS As Worksheet
Dim V As Variant
Dim I As Long
Set WS = Worksheets("sheet2")
With WS
V = .Range("a1", .Cells(.Rows.Count, "A").End(xlUp))
For I = UBound(V) To LBound(V) Step -1
'Revise this check line as needed
If Len(Trim(V(I, 1))) > 0 Then Exit For
Next I
Set R = .Cells(I, 1)
End With
Debug.Print R.Address
End Sub
You might want to add some error checking in case all of the cells are empty.
I'm trying to write a macro to change the colors of rows when the values in column B change. Column A will be my controlling column using 1's and 0's, i.e. column A will stay a 1 as long as column B stays the same; whenever B changes, A will flip to a 0, and so on.
I can get it to color the rows correctly when the values in column B change, but the problem arises when I filter the data. For example: let's say I have B2-B4 set to "test1", B5-B7 set to "test2", and B8-B10 set to "test3", then I filter column B to not include "test2". Originally, the rows would be colored differently where the column values changed, but rows B2-B4 and B8-B10 are set to the same color and now they're touching since the "test2" rows are hidden.
Here's the code I used to color the rows, but it doesn't work for filtering:
Sub ColorRows()
Dim This As Long
Dim Previous As Long
Dim LastRow As Long
Dim Color As Integer
Dim R As Long
LastRow = ActiveSheet.Range("A" & Rows.Count).End(xlUp).Row
RwColor = Array(15,0)
Color = 0
For R = 2 To LastRow
This = Cells(R, 1).Value
Previous = Cells(R - 1, 1).Value
If This <> Previous Then Color = 1 - Color
Range("A" & R & ":M" & R).Select
Selection.Interior.ColorIndex = RwColor(Color)
Next R
End Sub
How can I fix it so that even after filtering the rows are colored correctly when there is a change in column values?
Here's a way to do this:
1.) Insert the code below as a UDF in a code module.
2.) Then put the formula in A, as A2: =analyseVisible(B2).
This will compare B-cells to the next visible cell above and result in a 'rank'-counter in A.
Now that the counter in A in contiunous (even if rows are hidden), you can use MOD 2 to color it with conditional formatting:
3.) Add a conditional format (from A2 for the whole table): =MOD($A2,2)=1 and set the fill color.
If you use the filter now or change values in B, the rows are re-colored in realtime.
Public Function analyseVisible(r As Range) As Integer
Dim i As Long
If Application.Caller.Row <= 2 Or _
r.Row <> Application.Caller.Row Then
analyseVisible = 1
Exit Function
End If
i = r.Row - 1
While r.Worksheet.Rows(i).Hidden And i > 1
i = i - 1
Wend
If i = 1 Then
analyseVisible = 1
Else
analyseVisible = r.Worksheet.Cells(i, Application.Caller.Column).Value
If r.Worksheet.Cells(i, r.Column).Value <> _
r.Value Then analyseVisible = analyseVisible + 1
End If
End Function
The code below handles the issue by checking only the used & visible rows. It works pretty well, but I was unable to figure out how to fire it when the filter changes. It also does it's comparisons directly on the values that are changing.
Private Sub colorRows()
Dim this As Variant
Dim previous As Variant
Dim currentColor As Long
Dim rng As Range 'visible range
Dim c As Range ' cell
' pick a color to start with
currentColor = vbYellow
' rng = used and visible cells
Set rng = ActiveSheet.UsedRange.SpecialCells(xlCellTypeVisible)
For Each c In rng ' For each cell that is visible and used
If Not c.Row = 1 Then ' skip header row
this = c.Value
'some simple test logic to switch colors
If this <> previous Then
If currentColor = vbBlue Then
currentColor = vbYellow
ElseIf currentColor = vbYellow Then
currentColor = vbBlue
End If
End If
'set interior color
c.Interior.color = currentColor
previous = this
End If
Next c
End Sub
Then, in the module of the worksheet that you want to colorize, call the sub from the Worksheet_Activate() event. (In reality, you probably want a different event. I mostly work with Access, so I don't really know what's available to you. I'm just trying to point you in the right direction to what I'm sure is your next question if you stick with the method you started with.)
Private Sub Worksheet_Activate()
colorRows
End Sub