VBA without range

[Lara465]

Hello!

So I have this table for example. I want for it to create a new sheet with the vegetable name. Like this: search the price column for value= 10, find the corresponding vegetable for that price, which will be the red tomatoes and copy the words "red tomatoes" and create a new sheet which will be named "red tomatoes".
But I don't want to use ranges like B1 or E2, I want it to works no matter how many other random columns I insert between the vegetables and the price.
So: To find the 10 value under the column of Price, using the header("Price") of the column not column E, to know how to follow the same row until it reaches the column "Vegetable" not column B, and copy the value.
I don't know if it can be done or not.



I thought about something like this, but maybe you have a simpler way. And if I have 2 values of 10 in the price column, I need a loop to do the exact same thing for every 10 values.

Public Sub findColumn_Select()


  Dim coll As Range, cl as Range
  Dim address As String
  Dim selrow As Integer, selcol As Integer
 
  Set coll = Range("A1:Z100").Find("price")
     If coll Is Nothing Then
        MsgBox "Description column was not found."
      Exit Sub
      End If

  Range(coll, coll.End(xlDown)).Select

Selection.Find(What:="10", After:=ActiveCell, LookIn:=xlFormulas, _
        LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, _
        MatchCase:=False, SearchFormat:=False).Activate

address = ActiveCell.address
Range(address).Select

selrow = Selection.row

    With Worksheets("Sheet1").Cells
        Set cl = .Find("Vegetables", After:=.Range("A2"), LookIn:=xlValues)
        If Not cl Is Nothing Then
            cl.Select
        End If
    End With
   
selcol = Selection.Column

Cells(selrow, selcol).Select

End Sub

Thanks.

 

[footoo]

Try this :

Public Sub findColumn_Select()
Dim findPrice#: findPrice = 10
Dim price As Range, veg As Range, cel As Range
Dim vName$, x As Object, ws As Worksheet
Set ws = ActiveSheet

Set price = Range("A1:Z1").Find("price")
If price Is Nothing Then
    MsgBox "Price column was not found."
    Exit Sub
End If

Set veg = Range("A1:Z1").Find("Vegetables")
If veg Is Nothing Then
    MsgBox "Vegetables column was not found."
    Exit Sub
End If

For Each cel In ws.Range(price(2, 1), ws.Cells(Rows.Count, price.Column).End(3))
    If cel = findPrice Then
        vName = ws.Cells(cel.Row, veg.Column)
        On Error Resume Next
        Set x = ActiveWorkbook.Sheets(vName)
        If Err = 0 Then
            MsgBox " A sheet named '" & vName & "' already exists."
            GoTo n
        End If
        On Error GoTo 0
        Worksheets.Add(After:=ActiveSheet).Name = vName
    End If
n: Next
If vName = "" Then MsgBox " A price of " & findPrice & " does not exist."
ws.Select

End Sub

You might want to add an Input Box to get the price to look for, instead of hard coding it.

 

[alansidman]

code deleted. Not correct.

 

[Lara465]

Thank you.
Can I do an input Box to search only the price column, I will entry the value 10 for example, or a dropdown menu with the column content without duplicates, but I think the last one is too hard. Any ideas? I don't know how to say the input box is only for a specific column using its header, or something other that A1..

 

[footoo]

Try this :

Public Sub findColumn_Select()
Dim price As Range, veg As Range, cel As Range
Dim vName$, x As Object, ws As Worksheet
Dim findPrice As Variant

Application.DisplayAlerts = False
findPrice = Application.InputBox(prompt:="Please enter a price", Type:=1)
Application.DisplayAlerts = True
If TypeName(findPrice) = "Boolean" Then Exit Sub
findPrice = Val(findPrice)

Set ws = ActiveSheet

Set price = Range("A1:Z1").Find("price")
If price Is Nothing Then
    MsgBox "Price column was not found."
    Exit Sub
End If

Set veg = Range("A1:Z1").Find("Vegetables")
If veg Is Nothing Then
    MsgBox "Vegetables column was not found."
    Exit Sub
End If

For Each cel In ws.Range(price(2, 1), ws.Cells(Rows.Count, price.Column).End(3))
    If cel = findPrice Then
        vName = ws.Cells(cel.Row, veg.Column)
        On Error Resume Next
        Set x = ActiveWorkbook.Sheets(vName)
        If Err = 0 Then
            MsgBox " A sheet named '" & vName & "' already exists."
            GoTo n
        End If
        On Error GoTo 0
        Worksheets.Add(After:=ActiveSheet).Name = vName
    End If
n: Next
If vName = "" Then MsgBox " A price of " & findPrice & " does not exist."
ws.Select

End Sub

(BTW : tomato is not a vegetable)

 

[Lara465]

Yeah, thank you. This in not the table that I have to work with, I have some huge sheets, I just wrote something so that I can explain better what I need.
Thank you again.