I am trying to add code to one of my worksheets that determines what the first column is with a value in it for each row (excluding the first column A because it is all headings). I have searched but cannot find anything that works for the FIRST occurrence in a row. Thank you for the help.
The following code will return the cell address of the first occurrence of data in a row for a set of columns.
It's unclear to me from your question, whether you want to look for the first occurrence of data in a row for a given column (what I wrote below), or the first occurrence of data in a column for a given row (if you need this, change the word Columns to the word Rows in the below code).
Sub FindFirstRowWithData()
With Worksheets("Sheet1")
Dim lCol As Long
For lCol = 2 To 10 'loop through columns B to J
Dim rngFound As Range
Set rngFound = .Columns(lCol).Find(What:="*", SearchOrder:=xlByColumns, SearchDirection:=xlNext)
If Not rngFound is Nothing then
Debug.Print rngFound.Address
Else
Msgbox "No Data in column " & lCol.
End If
Next
End With
End Sub
try this
Option Explicit
Sub FindFirstColumn()
Dim rngToScan As Range
Dim value As Variant
value = "a" '<== set it as the value of which first occurrence you want to search for
Set rngToScan = ActiveSheet.Range("B2:F100") '<== set it as the actual range of which columns will be searched the first occurrence of variable 'value'
With rngToScan
.Offset(, .Columns.Count).Resize(, 1).FormulaR1C1 = "=match(""" & value & """,RC2:RC" & .Columns(.Columns.Count).Column & ",0)"
End With
End Sub
Related
I'm trying to write some code that will delete any row where the character "," or Chr(44) is not found in any of the cells in that row.
I've gotten this far but am struggling because the code is only searching column C for "," but I need it to search the entire current row.
How can I get this updated?
Sub DeleteRows()
' Defines variables
Dim Cell As Range, cRange As Range, LastRow As Long, x As Long
' Defines LastRow as the last row of data based on column C
LastRow = ActiveSheet.Cells(Rows.Count, "C").End(xlUp).row
' Sets check range as C1 to the last row of C
Set cRange = Range("C1:C" & LastRow)
' For each cell in the check range, working from the bottom upwards
For x = cRange.Cells.Count To 1 Step -1
With cRange.Cells(x)
' If the cell does not contain one of the listed values then...
If .value <> "Chr(44)" Then
' Delete that row
.EntireRow.Delete
End If
End With
' Check next cell, working upwards
Next x
End Sub
Probably easier to use the Find method of Range object, rather than doing cell-by-cell iteration. And you can use the EntireRow property of each cell Range to do this:
For x = cRange.Cells.Count To 1 Step -1
With cRange.Cells(x).EntireRow
If .Find(Chr(44)) Is Nothing Then
.Delete
End If
End With
Next
Also note per John's comment on OP, you were (mistakenly) comparing against a string literal "Chr(44)" when you need to be comparing against the evaluation of Chr(44) function, which returns a string: ",".
I'm trying to create a macro which will be adding a column to a named range provided on the value in a column next to a named range.
To be more specific, the range B:G is named "Furniture". Depending on the value in the first row of a column next to this range (A or H), I need to add a column to this named range. So if a cell H1 is "Furniture" then column H will be added to the named range "Furniture".
Of course, it has to be a universal method so that every column named "Furniture" next to this range will be added to it.
I'm a complete newbie to VBA, so I created a code attached below for a singular case. However, it doesn't work and, moreover, it's not a general code.
Range("H1").Select
If cell.Value = "Furniture" Then
With Range("Furniture")
.Resize(.Columns.Count + 1).Name = "Furniture"
End With
End If
If you could provide more information about the structure of your sheet, I could help you with a decent loop, because it's not clear how you want to loop through the columns / rows. Can the target range always be found in the first row of every column?
For now, this will help you hopefully, as it dynamically adds columns to a range. The name of the particular range comes from the selected cell.
lastColumn = Range("A1").SpecialCells(xlCellTypeLastCell).Column
For currentColumn = 1 To lastColumn
Cells(1, currentColumn).Activate
If Not IsEmpty(ActiveCell.Value) Then
targetRange = ActiveCell.Value
ActiveCell.EntireColumn.Select
On Error Resume Next
ActiveWorkbook.Names.Add Name:=targetRange, RefersTo:=Range(targetRange & "," & Selection.Address)
If Err <> 0 Then
Debug.Print "Identified range does not exists: " & targetRange
Else
Debug.Print "Identified range found, extended it with " & Selection.Address
End If
End If
Next currentColumn
Been awhile since I've done some programming and I'm not having much luck with a simple excel vba macro. I have data in a column and i need to select then delete the cells that do not contain a particular value. My data looks like this in a column:
990ppbAu/1,2
990ppbAu/0,5
990ppbAu/0,5
990ppbAu/0,3
9900ppmZr/29,1
9900ppmZn/5,2
9900ppmZn/1
9900ppmZn/0,8
9900ppmZn/0,5
9900ppmCu/2,8
I need to delete the values or strings that do not contain "Au" in them. Here is the start of my code, it's not much and probably wrong...but I'm hoping someone can point me in the right direction:
Option Explicit
Sub SearchColumn()
Dim strAu As String
Dim rngFound, rngDelete As Range
strAu = "*Au*"
'Search Column
With Columns("AF")
'Find values without "Au" in string in column AF and delete.
Set rngFound = .Find(strAu, .Cells(.Cells.Count), xlValues, xlWhole)
If rngFound <> strAu
'Then select the value and delete
'Else move onto the next cell until end of the document
End With
End Sub
I should note, some cells have nothing in them, while some have a string value as seen above. I need it to go through the entire column until end of document. There are about 115,000 records in the table. Thanks in advance!
Edited3 to delete cell content only
edited 2 make it delete single cell
edited to "reverse" the previous filtering criteria and keep cells containing "Au"
if your column has header then you can use this code:
Option Explicit
Sub SearchColumnWithHeader()
Dim strAu As String
strAu = "Au"
With ActiveSheet
With .Range("AF1", .Cells(.Rows.Count, "AF").End(xlUp))
.AutoFilter Field:=1, Criteria1:="<>*" & strAu & "*"
If Application.WorksheetFunction.Subtotal(103, .Cells) > 1 Then .Offset(1).Resize(.Rows.Count - 1).SpecialCells(xlCellTypeVisible).ClearContents
End With
.AutoFilterMode = False
End With
End Sub
I cant seem to find a solution for my application after endless searching. This is what I want to do:
I have cells in one excel sheet that can contain a mixture of dates and empty cells in one column. I want to then select the cells that have only dates and then copy them to a corresponding column in another sheet. They must be pasted in exactly the same order as in the first sheet because there are titles attached to each row. I do get it right with this code:
'Dim i As Long
'For i = 5 To 25
'If Not IsEmpty(Sheets("RMDA").Range("D" & i)) Then _
Sheets("Overview").Range("D" & i) = Sheets("RMDA").Range("D" & i)
'Next i
However, the dates in the first sheet are being updated on a daily basis and it can be that one title has not been updated (on another day) on the first sheet because the user has not checked it yet. If I leave it blank and If I follow the same procedure then it will "overwrite" the date in the second sheet and make the cell blank, which I do not want. I hope I was clear. Can someone please help me?
Regards
You can accomplish this very easily (and with little code) utilizing Excel's built-in AutoFilter and SpecialCells methods.
With Sheets("RMDA").Range("D4:D25")
.AutoFilter 1, "<>"
Dim cel as Range
For Each cel In .SpecialCells(xlCellTypeVisible)
Sheets("Overview").Range("D" & cel.Row).Value = cel.Value
Next
.AutoFilter
End With
you could try something like. This will give you the non blanks from the range, there may be an easier way... hope it helps
Sub x()
Dim rStart As Excel.Range
Dim rBlanks As Excel.Range
Set rStart = ActiveSheet.Range("d1:d30")
Set rBlanks = rStart.SpecialCells(xlCellTypeBlanks)
Dim rFind As Excel.Range
Dim i As Integer
Dim rNonBlanks As Excel.Range
For i = 1 To rStart.Cells.Count
Set rFind = Intersect(rStart.Cells(i), rBlanks)
If Not rFind Is Nothing Then
If rNonBlanks Is Nothing Then
Set rNonBlanks = rFind
Else
Set rNonBlanks = Union(rNonBlanks, rFind)
End If
End If
Next i
End Sub
Just because a cell is blank does not mean that it is actually empty.
Based on your description of the problem I would guess that the cells are not actually empty and that is why blank cells are being copied into the second sheet.
Rather than using the "IsEmpty" function I would count the length of the cell and only copy those which have a length greater than zero
Dim i As Long
For i = 5 To 25
If Len(Trim((Sheets("RMDA").Range("A" & i)))) > 0 Then _
Sheets("Overview").Range("D" & i) = Sheets("RMDA").Range("D" & i)
Next i
Trim removes all spaces from the cell and then Len counts the length of the string in the cell. If this value is greater than zero it is not a blank cell and therefore should be copied.
I have multiple cells on one row in excel that all contain HTML. Each cell is in a different lang but has the same URLs throughout eg: (...loc=en-uk) I need to find and replace this in each cell but with a different value for each cell eg: find "en-uk" in cell A, Replace with "it-it", mover to next cell, find "en-uk", replace with "es-es" and so on till empty cell is reached.
Had tried the following but it only takes find and replace values from the same 2 cells:
Dim Findtext As String
Dim Replacetext As String
Findtext = Range("B2").Value
Replacetext = Range("C2").Value
Cells.Replace What:=Findtext, Replacement:=Replacetext, LookAt:=xlPart, _
SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
You will want to use Cells, instead of Range, and loop through the columns using a Variable "lCol".
Range(Column Letter , Row Number) has it's limitations because you are using a letter. It's hard to add 1 to C.. C + 1 = D? So use Cells(row#, col#). That way, you can incrementally work your way through the columns or rows using numbers instead of letters. In this case, the variable is the column, so we will use lCol and loop from 1 to the Last Column Number. Replacing the text from an original source string using your original post as a starting point.
Note: I'm not sure where your original string was. Also, if you know what you are replacing from the original string, and find yourself looking at Row2 being all the same thing across the sheet, you can just set that in your replaceString statement below.
Try This - It's only a few lines, once you take out all the comments.
Sub TextReplace()
Dim sheetName As String
Dim findText As String
Dim replaceText As String
Dim lastCol As Long
Dim lCol As Long
'Set the sheetName here, so you don't have to change it multiple times later
sheetName = "Sheet1"
'Check the Last Column with a value in it in Row 3. Assuming Row 3 has the Replacement text.
lastCol = Sheets(sheetName).Cells(3, Columns.Count).End(xlToLeft).Column
'Assuming you have an original string in a cell. Range("A1"), in this case.
origString = Sheets(sheetName).Cells(1, 1).Value
'Loop through each Column - lCol is going to increase by 1 each time.
'Starting on Column B,since Column A contains your original String.
For lCol = 2 To lastCol
'Using Cells(row#, col#), instead of Range(ColLetter, row#) gives you the ability to loop with lCol.
findText = Sheets(sheetName).Cells(2, lCol).Value
replaceText = Sheets(sheetName).Cells(3, lCol).Value
'Put the value from Range("A1") with the text replaced from Row 2 with Row 3's value.
Sheets(sheetName).Cells(1, lCol) = Replace(origString, findText, replaceText)
Next lCol
End Sub
Edit: Updated Column to start on B, instead of A.
Try this (for row 16 and for row 20 for example):
Sub ReplaceTextinRow()
Dim lastCol, iter
lastCol = ActiveSheet.UsedRange.Columns.Count 'this approach is not always applicable
For iter = 1 To lastCol
'Cells(16, iter).Offset(4, 0).Value = Replace(Cells(16, iter).Value, "en-us", "en-uk")
Cells(20, iter).value = Replace(Cells(20, iter).value, Cells(20, iter).Offset(-4, 0).Value)
Next
End Sub