I have an Excel spreadsheet where I need to amend a specific column.
Step 1. Find the column name
Step 2. Mark the all populated rows in this column
Step 3. Proceed with certain action (mostly find and replace or if other column is “this” then amend my column for “that).
I would like those first 2 steps specified and leave me the space to amend the code easily for proceeding with step 3.
I have VBA code which does a similar job. It searches for the specific column name, it marks all rows populated. It does not allow me to easily copy and paste other code, found on the internet, to the main code.
MACRO WHICH FINDS THE COLUMN NAME AND MARKS ALL RECORDS IN THIS COLUMN
Sub FindAddressColumn()
Dim rngAddress As Range
Set rngAddress = Range("A1:ZZ1").Find("Address")
If rngAddress Is Nothing Then
MsgBox "Address column was not found."
Exit Sub
End If
Range(rngAddress, rngAddress.End(xlDown)).Select
End Sub
Most of macros found on the internet have the column specified.
EXAMPLE OF CODE THAT I WOULD LIKE TO ADD TO THE MAIN CODE:
Sub GOOD_WORKS_Find_Replace_Commas_in_Emails()
Sheets("Data").Activate
Dim i As String
Dim k As String
i = ","
k = "."
Columns("R").Replace What:=i, Replacement:=k, LookAt:=xlPart, MatchCase:=False
Sheets("Automation").Activate
MsgBox "Removing commas in emails - Done!"
End Sub
I believe what I miss is the code which will “say” for the already marked columns rows…. And here you paste only the part of the code found on the internet.
I think this code will do the job you want:
Sub ColumnReplace()
Dim TargetColumn As Range
Dim Header As String
Dim SearchFor As String
Dim ReplaceTo As String
Header = "ccc"
SearchFor = "111"
ReplaceTo = "99999"
Set TargetColumn = ThisWorkbook.ActiveSheet.Range("1:1").Find(Header, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
Set TargetColumn = Cells(1, TargetColumn.Column).EntireColumn
TargetColumn.Replace What:=SearchFor, Replacement:=ReplaceTo, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, _
ReplaceFormat:=False
End Sub
Adopt Workbook / Sheets names as well as strings for search / replace as you wish.
Sample file: https://www.dropbox.com/s/s7fghhlsmydjaf6/EntireColumnReplace.xlsm
Related
Using Excel, I'm trying to accomplish the following:
Sample of before & after
I need to convert all the 1's into the corresponding country name of each column. With a small dataset like the sample above, it is easy to do it manually, but not so easy when I have 196 columns x 2 datasets. Any suggestions would be much appreciated!
Duplicate the sheet and clear all the values except the header in the second sheet. Put the following formula in every corresponding cell except the header row in the second sheet.
=IF(INDIRECT(ADDRESS(ROW(),COLUMN(),1,1,"Sheet1"),TRUE)=1,
MID(INDIRECT(ADDRESS(1,COLUMN())),
FIND("[",INDIRECT(ADDRESS(1,COLUMN())))+1,
FIND("]",INDIRECT(ADDRESS(1,COLUMN())))-
FIND("[",INDIRECT(ADDRESS(1,COLUMN())))-1),"")
You can then copy the corresponding cells of the second sheet. Past values into the first sheet. You're done.
{You'll want to remove carriage returns from the formula. Also, you might want to delete the second sheet to hide the magic. :-) }
If you're willing to use vba instead of a formula, I think that this will work for you. It looks for non-empty cells within "A:F" and for those cells it grabs the name inside of [...]
Sub AdjustName()
Dim cell As Range
For Each cell In Range("A2:F" & LastRowInRange_Find(Range("A:F")))
If Len(cell.Value2) > 0 Then
With Cells(1, cell.Column)
cell.Value2 = Mid(.Value2, InStr(.Value2, "[") + 1, Len(.Value2) - 1 - InStr(.Value2, "["))
End With
End If
Next cell
End Sub
Function LastRowInRange_Find(ByVal rng As Range) As Long
'searches range from bottom up looking for "*" (anything)
Dim rngFind As Range
Set rngFind = rng.Find( _
What:="*", _
After:=Cells(rng.row, rng.Column), _
LookAt:=xlWhole, _
LookIn:=xlValues, _
SearchOrder:=xlByRows, _
SearchDirection:=xlPrevious)
If Not rngFind Is Nothing Then
LastRowInRange_Find = rngFind.row
Else
LastRowInRange_Find = rng.row
End If
End Function
In my continuing quest for making an easier job out of organizing an on-call schedule for my work place, I've hit another roadbump.
I got really great help with arranging a numbered schedule before that looks like this:
Picture of numbered schedule
Each of those numbers correspond to a specific name on the list in green to the right called "Personal".
Now I want to substitute those numbers with the names on the green list with a loop.
I tried doing it like this, by selecting the range of cells with the numbers and then making a loop to replace all individual numbers with the names in the list:
Sub FindReplaceAllTest(numOfEmployees As Integer)
Dim sht As Worksheet
Dim fnd As Integer
Dim rplc As Variant
fnd = 1
rplc = ThisWorkbook.Sheets("Duty Roster").Cells("17, fnd + 1").Value
For Each sht In ActiveWorkbook.Worksheets
Range("B2:F54").Select
Selection.Replace What:=fnd, replacement:=rplc, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
If fnd < numOfEmployees Then
fnd = fnd + 1
ElseIf fnd = numOfEmployees Then
fnd = 0
End If
Next sht
End Sub
The variable numOfEmployees is gathered in an earlier SUB where the names in the green list are counted and passed on into this variable, this for the sake of the process of creating the numbered list.
Unfortunatly it doesn't yield the desired results. I get error '1004' at the line:
rplc = ThisWorkbook.Sheets("Duty Roster").Cells("17, fnd + 1").Value
This seems to be caused by the fnd variable in that line. When i take out fnd and replace it with a regular row reference I get a result like this:
"Fnd" switched out for "2": "rplc = ThisWorkbook.Sheets("Duty Roster").Cells("17, 2").Value"
Even though I put "2" in the row I still get the name of the list as a substitute.
The correct sintax is the following
rplc = ThisWorkbook.Sheets("Duty Roster").Cells(17, fnd + 1).Value
Which will get you the value of cell in column "fnd+1" and row 17
Furthermore you're looping through sheets but never actually use them since you neither use "sht" nor prefix any range object with a "dot" to refer it to the "ruling" sht. Like follows:
For Each sht In ActiveWorkbook.Worksheets
sht.Range("B2:F54").Replace What:=fnd, replacement:=rplc, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False, _
SearchFormat:=False, ReplaceFormat:=False
Coming from this:
Schedule before numbers been replaced by the green list of employees
This code:
Sub FindReplaceAllTest(numOfEmployees As Integer)
Dim n As Integer
Dim fnd As Integer
Dim rplc As String
fnd = 1
Do Until n = numOfEmployees + 1
rplc = ThisWorkbook.Sheets("Duty Roster").Cells(fnd + 1, 17).Value
Range("B2:F54").Select
Selection.Replace What:=fnd, replacement:=rplc, _
LookAt:=xlWhole, SearchOrder:=xlByRows, MatchCase:=False,_
SearchFormat:=False, ReplaceFormat:=False
n = n + 1
fnd = fnd + 1
Loop
End Sub
Produced these results:
Schedule after numbers been replaced by the green list of employees
Many thanks to user3598756 for providing me with what I needed to solve this! She/He pointed out that I was writing parts in my code I did'nt need so I switched out my For Each Loop with a Do Until Loop and also replaced the sht variable with n (and rewrote them according to my needs) to make it work. He also made me aware that I had mixed up the placement of the column/row references. After editing that as well my code started producing the results I wanted.
So what my code now does is to compare the variable n with the variable numOfEmployees + 1 to make sure the loop stops when n > than numOfEmployees. Making sure all numbers are included. Furthermore the loop looks at fnd within my designated range and switching out all instances of that number with the value in the cell found at the variable rplc.
That's my (I hope correct, I'm fairly new to this) simplified answer to what I've done.
Thanks a bunch for the help!
First, my code (below) works, but I am trying to see if it can be simplified. The macro in which this code is located will have a lot of specific search items and I want to make it as efficient as possible.
It is searching for records with a specific category (in this case "Chemistry") then copying those records into another workbook. I feel like using Activate in the search, and using Select when moving to the next cell are taking too much time and resources, but I don't know how to code it to where it doesn't have to do that.
Here are the specifics:
Search column T for "Chemistry"
Once it finds "Chemistry", set that row as the "top" record. e.g. A65
Move to the next row down, and if that cell contains "Chemistry", move to the next row (the cells that contain "Chemistry" will all be together"
Keep going until it doesn't find "Chemistry", then move up one row
Set that row for the "bottom" record. e.g. AX128
Combine the top and bottom rows to get the range to select. e.g. A65:AX128
Copy that range and paste it into another workbook
Here is the code:
'find "Chemistry"
Range("T1").Select
Cells.Find(What:="Chemistry", After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Activate
'set top row for selection
toprow = ActiveCell.Row
topcellselect = "A" & toprow
'find all rows for Chemistry
Do While ActiveCell = "Chemistry"
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(-1, 0).Select
'set bottom row for selection
bottomrow = ActiveCell.Row
bottomcellselect = "AX" & bottomrow
'define selection range from top and bottom rows
selectionrange = topcellselect & ":" & bottomcellselect
'copy selection range
Range(selectionrange).Copy
'paste into appropriate sheet
wb1.Activate
Sheets("Chemistry").Select
Range("A2").PasteSpecial
Thanks in advance for any help!
You never need to select or activate unless that's really what you want to do (at the end of the code, if you want the user to see a certain range selected). To remove them, just take out the activations and selections, and put the things on the same line. Example:
wb1.Activate
Sheets("Chemistry").Select
Range("A2").PasteSpecial
Becomes
wb1.Sheets("Chemistry").Range("A2").PasteSpecial
For the whole code; I just loop thorugh the column and see where it starts and stops being "chemistry". I put it in a Sub so you only have to call the sub, saying which word you're looking for and where to Paste it.
Sub tester
Call Paster("Chemistry", "A2")
End sub
Sub Paster(searchWord as string, rngPaste as string)
Dim i as integer
Dim startRange as integer , endRange as integer
Dim rng as Range
With wb1.Sheets("Chemistry")
For i = 1 to .Cells(Rows.Count,20).End(XlUp).Row
If .Range("T" & i ) = searchWord then 'Here it notes the row where we first find the search word
startRange = i
Do until .Range("T" & i ) <> searchWord
i = i + 1 'Here it notes the first time it stops being that search word
Loop
endRange = i - 1 'Backtracking by 1 because it does it once too many times
Exit for
End if
Next
'Your range goes from startRange to endRange now
set rng = .Range("T" & startRange & ":T" & endRange)
rng.Copy
.Range(rngPaste).PasteSpecial 'Paste it to the address you gave as a String
End with
End sub
As you can see I put the long worksheet reference in a With to shorten it. If you have any questions or if it doesn't work, write it in comments (I haven't tested)
The most efficient way is to create a Temporary Custom Sort Order and apply it to your table.
Sub MoveSearchWordToTop(KeyWord As String)
Dim DestinationWorkSheet As Workbook
Dim SortKey As Range, rList As Range
Set SortKey = Range("T1")
Set rList = SortKey.CurrentRegion
Application.AddCustomList Array(KeyWord)
rList.Sort Key1:=SortKey, Order1:=xlAscending, Header:=xlGuess, _
OrderCustom:=Application.CustomListCount + 1, MatchCase:=False, _
Orientation:=xlTopToBottom, DataOption1:=xlSortNormal
Application.DeleteCustomList Application.CustomListCount
Set DestinationWorkSheet = Workbooks("Some Other Workbook.xlsx").Worksheets("Sheet1")
rList.Copy DestinationWorkSheet.Range("A1")
End Sub
I am working on a task in Excel 2007. I just started this job and I have to write a macro with a couple of steps and I'm kind of at a loss. Could someone help me along, and if I need to provide more information please let me know.
The macro has to loop through a single column top to bottom one cell at a time.
When the macro gets to the value it searches for that particular value throughout the entire workbook of the cell.
The macro looks at the next column of the value that is was searching for and references that value in another column of a separate worksheet.
Here is what I have so far:
Sub Sel_Class()
Dim cell As Range, rFind2 As Range, tagID As Integer, alias As String, sh As Workbooks
For Each cell In Worksheets("CList").Range("B2:B167").cells
Set cell = .find(what:="ActiveCell.Value", LookAt:=xlWhole, MatchCase:=False, SearchOrder:=x1ByRows, SearchFormat:=False)
If Not cell Is Nothing Then
for all sheets in workbook
.find(what:="ActiveCell.Value", LookAt:=xlWhole, MatchCase:=False, SearchOrder:=x1ByRows, SearchFormat:=False)
Do
List.Range("B" & Rows.Count).End(xlUp)(2) = rFind1.Offset(2)
Set rFind2 = .find(what:="Recruiter", After:=rFind1)
If Not rFind2 Is Nothing Then
Sheet2.Range("B" & Rows.Count).End(xlUp)(2) = rFind2.Offset(2)
End If
Set rFind1 = .find(what:="FG ID", After:=rFind2)
Loop While rFind1.Address <> sAddr
End If
End With
End Sub
I have a spreadsheet with a good amount of data (more than 100,000 rows with columns a-h).
I know twenty or more distinct values in Column F are wrong and I know what they should be. For example, every occurrence of "pif" should be "pig" and "coe" should be "cow", etc.
(Note that there are multiple incorrect values (i.e. multiple "pif"s) for each.)
I'm currently building a macro to go through and fix these individually, and that part works:
Sub FixColumnF()
ActiveSheet.Columns("F").Replace What:= _
"pif", _
Replacement:="pig", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
ActiveSheet.Columns("F").Replace What:= _
"coe", _
Replacement:="cow", LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:= _
False, SearchFormat:=False, ReplaceFormat:=False
...
End Sub
My problem is that column A is used to keep track of errors, one of which is an incorrect value in column F. How do I erase the value in column A to indicate there is no longer an error for each row where the value in column F is fixed?
I'm extremely new to vba, so any help would be very much appreciated!
Siddharth posted his suggestions while I was testing/typing mine. My first suggestion is a simple variation of his first suggestion and offers no advantage that I can see. However, my second suggestion is different from either of his suggestions and may be appropriate.
You need to loop for each occurrence of "pif" and "coe" if you want to do something extra with each faulty value found. The code below shows how to replace every occurrence of "pif" by "pig" and then do something with column "A". If you like this technique, you would need to duplicate this code for "coe" and "cow".
Option Explicit
Sub ReplaceFaultyA()
Dim Rng As Range
' It is best to avoid "ActiveSheet" in case the use has called the
' macro with the wrong worksheet active. Probably this is not likely
' in this case but I like to follow good practice even if it not not
' necessary
With Worksheets("Data")
Do While True
' Are you sure all your Find parameters are correct? For example,
' "LookAt:=xlPart" means than "pif" in the middle of a word will
' be replaced by "pig". "LookAt:=xlWhole" may better match your
' requirement. I suggest you look up the specification of Find
' and consider the implications of each parameter.
Set Rng = .Columns("F").Find(What:="pif")
If Rng Is Nothing Then
' No [more] occurrences of "pif" in column F
Exit Do
Else
' Occurrences of "pif" found in column F
.Cells(Rng.Row, "F") = "pig"
' Amend column ""A" of Rng.Row as necessary
End If
Loop
End With
End Sub
Duplication my loop and replacing "pif" and "pig" by "coe" and "cow" in the duplicate is probably the simpliest solution if there are only two replacements. However, if there are many replacements, the technique below may be a better choice.
In this code, I place the faulty values and the matching good values in arrays. With this approach, one block of replacement code can handle an indefinite number of replacements providing the action for column A is the same for each replacement.
Sub ReplaceFaultyB()
Dim InxValue As Long
Dim Rng As Range
Dim ValueFaulty() As Variant
Dim ValueGood() As Variant
' The code below assumes there same number of entries in both arrays.
' You can add extra entries to the two arrays as necessary.
' This assumes the action for column "A" is the same for each faulty value
ValueFaulty = Array("pif", "coe", "appme")
ValueGood = Array("pig", "cow", "apple")
With Worksheets("Data")
For InxValue = LBound(ValueFaulty) To UBound(ValueFaulty)
Do While True
Set Rng = .Columns("F").Find(What:=ValueFaulty(InxValue))
If Rng Is Nothing Then
' No [more] occurrences of this faulty value in column F
Exit Do
Else
' Occurrences of faulty value found in column F
.Cells(Rng.Row, "F") = ValueGood(InxValue)
' Amend column ""A" of Rng.Row as necessary
End If
Loop
Next InxValue
End With
End Sub
There are two ways that I can think of.
Way 1
Use .Find/.FindNext to loop though all the cells which have say the word "pif". In that loop not only replace the word but also edit the value in Col A. For example (Untested)
Sub Sample()
Dim oRange As Range, aCell As Range, bCell As Range
Dim ws As Worksheet
Dim SearchString As String, FoundAt As String
On Error GoTo Whoa
Set ws = Worksheets("Sheet1")
Set oRange = ws.Columns(5) '<~~ Column 5
SearchString = "pif"
NewString = "pig"
Set aCell = oRange.Find(What:=SearchString, LookIn:=xlValues, _
LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not aCell Is Nothing Then
Set bCell = aCell
'~~> Change value in Cell F
aCell.Value = Replace(aCell.Value, SearchString, NewString)
'~~> Change value in Cell A
aCell.Offset(, -5).Value = "Rectified"
Do
Set aCell = oRange.FindNext(After:=aCell)
If Not aCell Is Nothing Then
If aCell.Address = bCell.Address Then Exit Do
aCell.Value = Replace(aCell.Value, SearchString, NewString)
aCell.Offset(, -5).Value = "Rectified"
Else
Exit Do
End If
Loop
End If
Exit Sub
Whoa:
MsgBox Err.Description
End Sub
Way 2
Use Autofilter to filter Col F on the word "pif". Loop though all the cells in Col A and add the relevant message. Remove Autofilter and then run your original code (mentioned in your question) to do the replace in Col F. see THIS link on how to use Autofilter.