using a "found" value to define a new range - excel

I am trying to create a dynamic macro in VBA by which I can select a new range starting on a column with the title "Position Number". So my "program" ideally goes to the sheet, finds the range where I want to find this cell that says "Position Number", finds it, gives me the column number (as the column might change) and then it starts on that column to mark a new range and compare it with another sheet. I am so far stuck in the part where I am trying to use the column number I have found to define the new range. I have tried lots of things I found online, but cant fix it.
The error is on:
Set Range1 = Range("'C'& ColNum" & "R1")
I tried a few other variants of this but it does not work or gives me a number as output.
Thanks in advance!
Dim FilledRange As Range
Dim Range1 As Range
Dim Rng As Range
Dim ColNum As String
Worksheets("FILLED Today").Activate
Set FilledRange = Range("a1")
FilledRange.CurrentRegion.Select
Selection.Find(What:="Position Number", After:=ActiveCell, LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
ColNum = ActiveCell.Column
MsgBox (ColNum)
Set Range1 = Range("'C'& ColNum" & "R1")
MsgBox (Range1)

Use Cells:
Set Range1 = Cells(1,Colnum)
One should avoid .Select and .Activate:
Dim FilledRange As Range
Dim Range1 As Range
Dim Rng As Range
Dim findrng As Range
Dim ColNum As Long
With Worksheets("FILLED Today")
Set FilledRange = .Range("A1").CurrentRegion
Set findrng = FilledRange.Find(What:="Position Number", After:=.Range("A1"), LookIn:= _
xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not findrng Is Nothing Then ' test to ensure it was found.
ColNum = findrng.Column
MsgBox ColNum
Set Range1 = .Cells(1, ColNum)
MsgBox Range1
Else
MsgBox "String not found in Range"
End If
End With

Related

Find a string in the column and active application Go to

I need to find a string that will be always on the Row 3 but any column in a specific sheet, after the code find it the application GoTo should take the user to this column. However, I am having trouble with my code, maybe someone knows what I am doing wrong?
Sub Pivot1()
Dim SearchString As String
Dim SearchRange As Range, cl As Range
Dim FirstFound As String
Dim sh As Worksheet
' Set Search value
SearchString = "Nr. 1"
Application.FindFormat.Clear
With Sheets("Analysis").Cells(3, Columns.Count).End(xlToLeft).Column
Set cl = .Find(What:=SearchString, After:=Range("A:FA"), LookIn:=xlValues, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cl Is Nothing Then Application.Goto cl
End With
End Sub

Search and selecting a string in a Worksheet using VBA

I know selection is not good to use. However, I need to find a string in another sheet and need it to be selected (it can even select and change the color) so the user will able to see it.
My code is only taking me to the sheet but not to the cell where the string I need to find is.
Sub Risk1()
Dim SearchString As String
Dim SearchRange As Range, cl As Range
Dim FirstFound As String
Dim sh As Worksheet
' Set Search value
SearchString = "1."
Application.FindFormat.Clear
Sheet2.Activate
' loop through all sheets
For Each sh In ActiveWorkbook.Worksheets
' Find first instance on sheet
Set cl = sh.Cells.Find(What:=SearchString, _
After:=sh.Cells(1, 1), _
LookIn:=xlValues, _
lookat:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False, _
SearchFormat:=False)
If Not cl Is Nothing Then
FirstFound = cl.Activate.cell
End If
Next
End Sub
The string that I am looking for can be in any cell of column A.
Try this. If it's in one sheet no need to loop through all of them. It's still not clear to me what happens if the value is found more than once?
Btw you don't need VBA for this, the worksheet Find will do exactly this.
Sub Risk1()
Dim SearchString As String
Dim SearchRange As Range, cl As Range
Dim FirstFound As String
Dim sh As Worksheet
' Set Search value
SearchString = "1."
Application.FindFormat.Clear
With Sheets("Over").Columns(1)
Set cl = .Find(What:=SearchString, After:=.Cells(1, 1), LookIn:=xlValues, _
lookat:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=False, SearchFormat:=False)
If Not cl Is Nothing Then Application.Goto cl 'better than select or activate and sheet does not need to be active first
End With
End Sub

Storage of Range Values after .Find

This is part of a bigger code that both filters based on input text and then creates subtotals out of the values associated with warranty subtypes, this is applied to several different sheets and it all works.
There is the possibility of many different Warranties subtypes.
I check for each one individually, first for an exact match case for "WarrantyPrefA Total" (this should be on the AJ Column).
If it exists, I want to store that range value inside a variable(GaRangeID), so I can apply an offset of that range to grab the two numerical values present in other columns and paste it on another Workbook.
If it doesn't exist, I want to terminate that find, and find another exact match case.
My guess is I'm messing up the .Find inner syntax to search the correct range.
Dim GaRangeID As Range
Dim WBModeloA1 As Worksheet
Dim WBModeloA2 As Worksheet
Set WBModeloA1 = Workbooks("ModeloAnalisis.xlsm").Sheets("Cartera 1")
Set WBModeloA2 = Workbooks("ModeloAnalisis.xlsm").Sheets("Cartera 3")
'GPB
Dim strSearch As String
Dim lastrow As Long
strSearch = "WarrantyPrefA Total"
lastrow = WBevoDeuM.Range("AJ" & Rows.Count).End(xlUp).Row
Set GaRangeID = WBevoDeuM.Range("AJ1", "AJ" & lastrow).Find(What:=strSearch, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not GaRangeID Is Nothing Then
WBModeloA1.Range("E67") = GaRangeID.Offset(0, -3).Range("A1")
WBModeloA1.Range("E67").Value = WBModeloA1.Range("E67").Value / 1000
WBModeloA2.Range("H91") = GaRangeID.Offset(0, -21).Range("A1")
WBModeloA2.Range("H91").Value = WBModeloA2.Range("H91").Value / 1000
Else
End If
'GPA
Set GaRangeID = Cells.Find(What:="WarrantyPrefB Total", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False)
If Not GaRangeID Is Nothing Then
WBModeloA1.Range("E65") = GaRangeID.Offset(0, -3).Range("A1")
WBModeloA1.Range("E65").Value = WBModeloA1.Range("E65").Value / 1000
WBModeloA2.Range("H90") = GaRangeID.Offset(0, -21).Range("A1")
WBModeloA2.Range("H90").Value = WBModeloA2.Range("H90").Value / 1000
Else
End If
The reason I show it repeats the same structure but with another find afterwards is because I used to have the "find" part defined in another way.
The following way properly pastes the subtotals onto the other workbook, but I discarded it since it always sets the GaRangeID as the active cell, when the search gets nothing, the active cell remains as the old subtotal found, and so it just pastes the values of WarrantyA onto B.
Cells.Find(What:="WarrantyPrefB Total", After:=ActiveCell, LookIn _
:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:= _
xlNext, MatchCase:=False, SearchFormat:=False).Activate
Set GaRangeID = ActiveCell
I don't have much to offer except to simplify your code a bit and use xlValues instead of xlFormulas for the LookIn parameter
Sub Tester()
Dim f As Range
Dim WBModeloA1 As Worksheet
Dim WBModeloA2 As Worksheet
Dim wsData As Worksheet, rngSearch As Range
'use "ThisWorkbook" if it's where your code lives
Set WBModeloA1 = ThisWorkbook.Sheets("Cartera 1")
Set WBModeloA2 = ThisWorkbook.Sheets("Cartera 3")
Set wsData = ThisWorkbook.Sheets("Data") 'the sheet you're searching
'define a range to search
Set rngSearch = wsData.Range(wsData.Range("AJ1"), _
wsData.Cells(Rows.Count, "AJ").End(xlUp))
'if you have multiple of these following blocks you really need a loop
Set f = rngSearch.Find(what:="WarrantyPrefA Total", LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False)
If Not f Is Nothing Then
WBModeloA1.Range("E67") = f.Offset(0, -3).Value / 1000
WBModeloA2.Range("H91") = f.Offset(0, -21).Value / 1000
End If
Set f = rngSearch.Find(what:="WarrantyPrefB Total", LookIn:=xlValues, _
lookat:=xlWhole, MatchCase:=False)
If Not f Is Nothing Then
WBModeloA1.Range("E65") = f.Offset(0, -3).Value / 1000
WBModeloA2.Range("H90") = f.Offset(0, -21).Value / 1000
End If
End Sub

Search and filter based on InputBox entry

I'm hoping to achieve the following:
Take user input via the Input box.
Search the table headers for that text.
Filter the found column to remove all blank cells (Leaving just the cells with data in.)
I've progressed a bit with a script I found, to give the input box, search the table header and select the found cell.
I need to merge into this the step of filtering the column of the found cell. If I record the steps it filters the same column no matter what I search for, so I think I need a way of reading back the found cell details and choosing that column to filter out blanks.
Sub Find_First()
Dim FindString As String
Dim Rng As Range
FindString = Application.InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("ACM").Range("B2:DA2") ' This is the table headers
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlWhole, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
End Sub
I now have it working using the following code, the only error I now get is a 1004 (WorksheetFunction class) error if I cancel the InputBox :-
Sub Find_First()
Dim i1 As Integer
Dim FindString As String
Dim Rng As Range
Dim rngData As Range
Set rngData = Application.Range("A2").CurrentRegion
FindString = Application.InputBox("Enter a Search value")
If Trim(FindString) <> "" Then
With Sheets("ACM").Range("B2:DA2") ' This is the table headers
Set Rng = .Find(What:=FindString, _
After:=.Cells(.Cells.Count), _
LookIn:=xlValues, _
LookAt:=xlPart, _
SearchOrder:=xlByRows, _
SearchDirection:=xlNext, _
MatchCase:=False)
If Not Rng Is Nothing Then
Application.Goto Rng, True
Else
MsgBox "Nothing found"
End If
End With
End If
i1 = Application.WorksheetFunction.Match(FindString, Application.Range("A2:CZ2"), 0)
Rng.AutoFilter Field:=i1, Criteria1:="<>"
End Sub
Looks like you really need the autofilter worked out:
I've done this in a similar scenario:
Dim i1 as Interger
Dim rngData as Range
Set rngData = ws.Range("A1").CurrentRegion
Using Match to find my column number matching FindString
i1 = Application.WorksheetFunction.Match(FindString, ws.Range("A1:CZ1"), 0)
rngData.AutoFilter Field:=i1, Criteria1:="<>"

Create repeat excel macro code until no more text mentions

I have created this macro code using the record function.
Sub Macro1()
Cells.Find(What:="Text to find", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Range("E5").Select
ActiveCell.FormulaR1C1 = "text to enter"
Range("D6").Select
Cells.Find(What:="Text to find", After:=ActiveCell, LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
MatchCase:=True, SearchFormat:=False).Activate
Range("E9").Select
ActiveCell.FormulaR1C1 = "text to enter"
End Sub
I need this macro to continue through the same column until it cannot find any more instances of the searched for word without it going back to the top of the column.
So it starts in a column, every time it finds a specified word it tabs across 1 column and pastes in a specified word.
It continues to search for the specified word in the same column until it cannot find it without starting at the top of the column.
Hope that makes some sense.
Not sure I understand but I think what your looking for is:
For each cell in columns(4).cells
If cell.value="Text to find" Then Cell.offset(0,1) = "Text to enter"
Next cell
You can use Find and FindNext to do this quickly, ie to:
search column D for the text in StrOld
enter any matches into column E with the text in StrIn
code
Sub Recut()
Dim strAddress As String
Dim StrIn As String
Dim StrOut As String
Dim rng1 As Range
StrOld = "Old"
StrIn = "New"
Set rng1 = Range("D:D").Find(StrOld, , xlFormulas, xlWhole, , , True)
If Not rng1 Is Nothing Then
strAddress = rng1.Address
Do
rng1.Offset(0, 1) = StrIn
Set rng1 = Range("D:D").FindNext(rng1)
Loop While Not rng1 Is Nothing And rng1.Address <> strAddress
End If
End Sub

Resources