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
Related
I am working with data where the only consistency is the layout and the bold headings to distinguish between a new date.
I am trying to find the cells in between these cells in bold, find the value "Individual" (in column A) in the selected rows, then sum the values of the given rows in column D (as there can be more then 1 row with "Individual"), and copy this new value to a different cell.
Since the cells between the bold is one date, if the value is not there, the output cell needs to shift down one without filling in anything.
Here is what I have so far:
Sub SelectBetween()
Dim findrow As Long, findrow2 As Long
findrow = range("A:A").Find("test1", range("A1")).Row
findrow2 = range("A:A").Find("test2", range("A" & findrow)).Row
range("A" & findrow + 1 & ":A" & findrow2 - 1).Select
Selection.Find("Individual").Activate
range("D" & (ActiveCell.Row)).Select
Selection.copy
sheets("Mix of Business").Select
range("C4").Select
ActiveSheet.Paste
Exit Sub
errhandler:
MsgBox "No Cells containing specified text found"
End Sub
How can I loop through the data and each time it loops through a range, no matter if it finds the value (e.g. individual) or not, shifts down one row on the output cell? Also, how can I change the findrow to be a format (Bold) rather then a value?
Here is some data for reference:
This is what I am trying to get it to look like:
So you have a good start to trying to work through your data. I have a few tips to share that can hopefully help get you closer. (And please come back and ask more questions as you work through it!)
First and foremost, try to avoid using Select or Activate in your code. When you look at a recorded macro, I know that's all you see. BUT that is a recording of your keystrokes and mouseclicks (selecting and activating). You can access the data in a cell or a range without it (see my example below).
In order to approach your data, your first issue is to figure out where your data set starts (which row) and where it ends. Generally, your data is between cells with BOLD data. The exception is the last data set, which just has a many blank rows (until the end of the column). So I've created a function that starts at a given row and checks each row below it to find either a BOLD cell or the end of the data.
Private Function EndRowOfDataSet(ByRef ws As Worksheet, _
ByVal startRow As Long, _
Optional maxRowsInDataSet As Long = 50) As Long
'--- checks each row below the starting row for either a BOLD cell
' or, if no BOLD cells are detected, returns the last row of data
Dim checkCell As Range
Set checkCell = ws.Cells(startRow, 1) 'assumes column "A"
Dim i As Long
For i = startRow To maxRowsInDataSet
If ws.Cells(startRow, 1).Font.Bold Then
EndRowOfDataSet = i - 1
Exit Function
End If
Next i
'--- if we make it here, we haven't found a BOLD cell, so
' find the last row of data
EndRowOfDataSet = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
End Function
To show you how to use that with your specific data, I've created a test subroutine indicating how to loop through all the different data sets:
Option Explicit
Public Sub DataBetween()
Dim thisWB As Workbook
Dim dataWS As Worksheet
Set thisWB = ThisWorkbook
Set dataWS = thisWB.Sheets("YourNameOfSheetWithData")
'--- find the first bold cell...
'Dim nextBoldCell As Range
'Set nextBoldCell = FindNextBoldInColumn(dataWS.Range("A1"))
'--- now note the start of the data and find the next bold cell
Dim startOfDataRow As Long
Dim endOfDataRow As Long
Dim lastRowOfAllData As Long
startOfDataRow = 3
lastRowOfAllData = dataWS.Cells(ws.Rows.Count, "A").End(xlUp).Row
'--- this loop is for all the data sets...
Loop
endOfDataRow = EndRowOfDataSet(dataWS, startOfDataRow)
'--- this loop is to work through one data set
For i = startOfDataRow To endOfDataRow
'--- work through each of the data rows and copy your
' data over to the other sheet here
Next i
startOfDataRow = endOfDataRow + 1
Do While endOfDataRow < lastRowOfAllData
End Sub
Use both of those together and see if that can get you closer to a full solution.
EDIT: I should have deleted that section of code. It was from an earlier concept I had that didn't completely work. I commented out those lines (for the sake of later clarity in reading the comments). Below, I'll include the function and why it didn't completely work for this situation.
So here's the function in question:
Public Function FindNextBoldInColumn(ByRef startCell As Range, _
Optional columnNumber As Long = 1) As Range
'--- beginning at the startCell row, this function check each
' lower row in the same column and stops when it encounters
' a BOLD font setting
Dim checkCell As Range
Set checkCell = startCell
Do While Not checkCell.Font.Bold
Set checkCell = checkCell.Offset(1, 0)
If checkCell.Row = checkCell.Parent.Rows.Count Then
'--- we've reached the end of the column, so
' return nothing
Set FindNextBoldInColumn = Nothing
Exit Function
End If
Loop
Set FindNextBoldInColumn = checkCell
End Function
Now, while this function works perfectly well, the situation is DOES NOT account for is the end of the last data set. In other words, a situation like this:
The function FindNextBoldInColumn will return nothing in this case and not the end of the data. So I (should have completely) deleted that function and replaced it with EndRowOfDataSet which does exactly what you need. Sorry about that.
Hellow,
I have a problem with copy past code
I can't identify the last cell in the row "where I would like to past" !!?
Here in the next code, I wrote "Shet.Cells(Rows.Count, "N").End(xlUp).row + 1", and it works well just in case there are no hidden rows, except that last row's value always replace itself !!
So, what should I do to update last row's value every time I execute Sub Copy_Past() ???
Sub Copy_Past()
Dim Shet As Worksheet
Set Shet = ThisWorkbook.Sheets(1)
Dim LRow As Long
'To get the latest cell in the column "N", where I would like to paste my data.
LRow = Shet.Cells(Rows.Count, "N").End(xlUp).row + 1
'To make a copy form where I selected
Selection.SpecialCells(xlCellTypeVisible).Copy ActiveSheet.Cells(LRow, "M")
'To delete the range of data that I selected and after coping them
Selection.SpecialCells(xlCellTypeVisible).Delete (xlShiftUp)
End Sub
I found a solution for this :)
I brought this method from here
https://answers.microsoft.com/en-us/msoffice/forum/msoffice_excel-msoffice_custom-mso_2007/finding-last-row-including-hidden-rows/af0d7d7c-84f1-44bf-b36a-5abc98a93fa6
Sub xlCellTypeLastCell_Example_Column()
For LastRow = Columns("N").SpecialCells(xlCellTypeLastCell).row To 1 Step -1
If Len(Cells(LastRow, "N").Formula) Then Exit For
Next
MsgBox LastRow
End Sub
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
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 use VBA for a find/replace. The goal is to iterate through a "Data_Pairs" sheet which contains all the pairs to find/replace, and to find/replace those pairs only in Column A and only in a specified range of sheets in the workbook (which does not include "Data_Pairs").
For some reason, every matching value is replaced, regardless of which column it's in. Values are also replaced in sheets whose index falls outside the defined range.
Any help would be greatly appreciated.
I'm using the following code:
Sub Replace_Names()
Dim row As Integer
Dim row2 As Integer
Dim sheet As Integer
Dim findThisValue As String
Dim replaceWithThisValue As String
For row = 1 To 10
Worksheets("Data_Pairs").Activate
findThisValue = Cells(row, "A").Value
replaceWithThisValue = Cells(row, "B").Value
For sheet = 2 To 10
Worksheets(sheet).Columns("A").Replace What:= findThisValue, Replacement:=replaceWithThisValue
Next sheet
Next row
End Sub
To give a concrete example of the issue: if Data_Pairs A1 = A and Data_Pairs B1 = 1, every single value of 1 in the entire workbook is replaced with A.
I observe this works as-expected in Excel 2010, echoing Greg and chancea's comments above.
HOWEVER, I also observe that if you have previously opened the FIND dialog (for example you were doing some manual find/replace operations) and changed scope to WORKBOOK, then the observed discrepancies will occur, as discussed here:
http://www.ozgrid.com/forum/showthread.php?t=118754
This may be an oversight, because it does not appear to have ever been addressed. While the Replace dialog allows you to specify Workbook versus Worksheet, there is no corresponding argument you can pass to the Replace method (documentation).
Implement the hack from the Ozgrid thread -- for some reason, executing the .Find method seems to reset that. This appears to work:
Sub Replace_Names()
Dim row As Integer
Dim row2 As Integer
Dim sheet As Integer
Dim findThisValue As String
Dim replaceWithThisValue As String
Dim rng As Range
For row = 1 To 10
Worksheets("Data_Pairs").Activate
findThisValue = Cells(row, "A").Value
replaceWithThisValue = Cells(row, "B").Value
For sheet = 2 To 3
Set rng = Worksheets(sheet).Range("A:A")
rng.Find ("*") '### HACK
rng.Replace What:=findThisValue, Replacement:=replaceWithThisValue
Next sheet
Next row
End Sub
You have a Worksheets("Data_Pairs").Activate inside your For ... Next loop. That would seem to indicate that the command is called 9× more that it has to be. Better not to reply on .Activate to provide the default parent of Cells.
Sub Replace_Names()
Dim rw As long, ws As long
Dim findThis As String, replaceWith As String
with Worksheets(1)
For rw = 1 To 10
findThis = .Cells(rw , "A").Value
replaceWith = .Cells(rw , "B").Value
For ws = 2 To 10 ' or sheets.count ?
with Worksheets(ws)
.Columns("A").Replace What:= findThis, Replacement:=replaceWith
end with
Next ws
Next rw
end with
End Sub
See How to avoid using Select in Excel VBA macros for more on getting away from Select and Acticate.