I'm trying to get the value of the first filter result that is in column C. The headers are on A5 to J5 and then the results are below. Pointing to C6 gives me the value of the first row in the database when it isn't filtered. I've read online that using
Range("C" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value
Would return the value as this takes into account that some of the rows are filtered out, but this doesn't work for me. I tried putting it in my GetNextResult subroutine below where I have Set the FilteredData Range variable, and it prompts Compile Error, Invalid or Unqualified Reference.
Just to make it clear, the first subroutine, FilterData, is actually the one that filters the data. The second subroutine, GetNextResult, calls on FilterData() but the purpose of this subroutine is to insert the value of each result into a textbox, one by one upon each execution of this macro.
Not that it's particularly relevant to the issue but in case it's important, the reason I want the value of the first result when filtered is for the purposes of a counter. I'm looking to make it so every time the GetNextResult macro sends the next result to the text boxes the counter goes up by one, so that the user can keep track of how many they've cycled through and not get to the point where they don't realise they're seeing the same results over and over. I figured, if I can get the value of the first filtered row then I can make an if statement say that if the textbox contains this value then make sure counter is 1, and that is the reset point.
Public Sub FilterData()
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Database")
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim CriteriaRange As Range
Set CriteriaRange = ws.Range("A2", "C3")
If Range("C3").Value = "Any" Then
Set CriteriaRange = ws.Range("A2", "B3")
End If
Dim DataRange As Range
Set DataRange = ws.Range("A5", "J" & LastRow)
DataRange.AdvancedFilter Action:=xlFilterInPlace, CriteriaRange:=CriteriaRange, Unique:=False
Call last_used_sort
If Not DataRange.Columns(1).Rows.SpecialCells(xlCellTypeVisible).Count > 1 Then
Call ShowAll
MsgBox "No Results"
Exit Sub
End If
End Sub
Public Sub GetNextResult()
FilterData
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Database")
Dim header As String
header = "Cards"
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim DataRange As Range
Set DataRange = ws.Range("A5", "J" & LastRow)
Dim FilteredData As Range
Set FilteredData = DataRange.Resize(ColumnSize:=1).SpecialCells(xlCellTypeVisible)
If CurrentRow + 1 > FilteredData.Cells.Count Then
CurrentRow = 1
End If
CurrentRow = CurrentRow + 1
With FilteredData
first_row = Range("C" & .Offset(1, 0).SpecialCells(xlCellTypeVisible)(1).Row).Value
End With
Debug.Print first_row
Dim i As Long
Dim cell As Variant
Static counter As Long
counter = counter + 1
If counter = Quick_Insert_Range Then
counter = 1
End If
ActiveSheet.Shapes("Cardcounter").TextFrame.Characters.Text = counter
For Each cell In FilteredData
i = i + 1
If i = CurrentRow Then
Call ShowAll
TextboxName = "txt1"
ActiveSheet.Shapes(TextboxName).DrawingObject.Text = cell.Offset(0, 2)
TextboxName2 = "txt2"
ActiveSheet.Shapes(TextboxName2).DrawingObject.Text = cell.Offset(0, 3)
TextboxName3 = "txt3"
ActiveSheet.Shapes(TextboxName3).DrawingObject.Text = cell.Offset(0, 4)
If ActiveSheet.Shapes(TextboxName).DrawingObject.Text = header Then
Call GetNextResult
End If
Call quick_artwork
Else
Call ShowAll
End If
Next cell
End Sub
In your second code, you did not CALL Filter Data. Your first 2 lines of code should be
Public Sub GetNextResult()
Call FilterData
Related
Im trying to create a table that pulls data from my raw data if certain conditions are met. The code I currently have does not seem to be working.
Public Sub insert_rows()
Dim datasheet As Worksheet
Dim datasheet2 As Worksheet
Dim r As Long
Dim tableA As ListObject
Set tableA = Worksheets(Sheet7).ListObject(Preventable)
Set datasheet = Worksheets(Sheet7)
Set datasheet2 = Worksheets("Data")
With datasheet2
nr = Cells(Rows.Count, 1).End(x1up).Row
For r = 1 To nr
If Cells(r, 17) = "Y" Then
Cells(r, 16).Copy Destination:=Sheets("Sheet7").Range("B4")
End If
Next
End With
End Sub
Basically I have several worksheets and need to pull data from one of them to add to this table in another worksheet. My condition is if the Column in the raw data worksheet contains "Y", then pull cell values into the table of the other worksheet. An image below is an example of the data I want to copy and paste over:
As you can see, they are string values separated by "," and can contain duplicates.
I only want to add just the unique entries into the new table; with no repetition of cells. Anyway I could modify this code to suit those conditions?
You could try something like this:
Public Sub insert_rows()
Dim datasheet As Worksheet
Dim datasheet2 As Worksheet
Dim r As Long, i As Long, nr As Long
Dim tableStartingRow As Long, currenttableitem As Long
Dim stringvalues As Variant
Dim stringseparator As String
Dim valueexists As Boolean
tableStartingRow = 4
stringseparator = ","
Set datasheet = Worksheets("Sheet7")
Set datasheet2 = Worksheets("Data")
With datasheet
currenttableitem = .Cells(.Rows.Count, 2).End(xlUp).Row
End With
With datasheet2
nr = .Cells(.Rows.Count, 16).End(xlUp).Row
For r = 1 To nr
If .Cells(r, 17) = "Y" Then
If InStr(.Cells(r, 16), stringseparator) > 0 Then 'If value contains comma
stringvalues = Split(.Cells(r, 16), stringseparator)
For i = LBound(stringvalues) To UBound(stringvalues)
valueexists = False 'Reset boolean
For x = tableStartingRow To currenttableitem
If datasheet.Range("B" & x).Value = Trim(stringvalues(i)) Then
valueexists = True
Exit For
End If
Next x
If Not valueexists Then
currenttableitem = currenttableitem + 1
datasheet.Range("B" & currenttableitem).Value = Trim(stringvalues(i))
End If
Next i
Else
valueexists = False 'Reset boolean
For x = tableStartingRow To currenttableitem
If datasheet.Range("B" & x).Value = .Cells(r, 16).Value Then
valueexists = True
Exit For
End If
Next x
If Not valueexists Then
currenttableitem = currenttableitem + 1
datasheet.Range("B" & currenttableitem).Value = .Cells(r, 16).Value
End If
End If
End If
Next
End With
End Sub
This code will check each value of the cells and will split the contents by ",". Then compare with the content of the table to see if this value is already in there. In case it is not, it will be added, otherwise omitted.
Also, I notice the use of the Cells inside of a With statement. That was making a reference to the active worksheet. To make reference to the item in the With statement, you need to use .Cells
I hope this will help.
My knowledge in VBA coding is zero. I wonder if someone can help with this question, please.
I have this initial code tried to write but it is wrong. I was not sure how to add these below conditions in the code.
Question: I want to auto number column A which starts at a specific Cell, A3 and it auto-numbers as long as there is text in Column B and Column C.
Here's the sample data picture. Thanks in advance!
Sub test()
Set r = Range("a3", Range("b" & Rows.Count).End(xlUp)).Offset(, -1)
With r
If .MergeCells <> True Then
r = r +1
Else
' Skip
End With
End Sub
Assuming your sheet is named Sheet1, you may use something like this:
Sub Test()
Dim lastRow As Long, i As Long, counter As Long
With Sheet1
lastRow = .Range("B" & .Rows.Count).End(xlUp).Row
For i = 3 To lastRow
If Not IsEmpty(.Cells(i, 2)) And Not IsEmpty(.Cells(i, 3)) Then
counter = counter + 1
.Cells(i, 1).Value = counter
End If
Next
End With
End Sub
Note: Using IsEmpty to check if any of the cells in columns B & C is empty already covers the case of cells being merged because in that case, at least one of the two cells has to be empty anyway.
Demo:
You have r as a range, you can't add a number to it and have it increment the range. (Though I did just test it and it doesn't throw an error which is strange)
Also Skip is not a thing in VBA, if you want to skip in a loop you need a conditional or a goto. Though you have no loop.
Sub test()
Dim i As Long
Dim lastrow As Long
Dim counter As Long
counter = 1
With ActiveSheet ' Change this to the real sheet name
lastrow = .Cells(.Rows.Count, 2).End(xlUp).Row ' Gets Last row
For i = 3 To lastrow ' Loop
If not isempty(.Cells(i, 2).Value) And not IsEmpty(.Cells(i, 3).Value) Then ' Looks for Text
If Not .Cells(i, 1).MergeCells Then ' Looks for merged cells
.Cells(i, 1).Value = counter ' Adds count
counter = counter + 1 ' Increments count
End If
End If
Next i
End With
See for comments and customize to fit your needs:
Public Sub AutoNumber()
' Declare objects
Dim evalRange As Range
Dim evalCell As Range
' Declare other variables
Dim sheetName As String
Dim initialCellAddress As String
Dim lastRow As Long
Dim columnNumber As Long
Dim counter As Long
' Customize to fit your needs
sheetName = "Sheet1"
initialCellAddress = "B2"
counter = 1
' Get column number and last row number to define the range address ahead
columnNumber = Range(initialCellAddress).Column
lastRow = ThisWorkbook.Worksheets(sheetName).Cells(Rows.Count, columnNumber).End(xlUp).Row
' Define the range to be evaluated
Set evalRange = ThisWorkbook.Worksheets(sheetName).Range(initialCellAddress & ":" & Left$(initialCellAddress, 1) & lastRow)
' Loop through each cell in range (in the original example we'll loop through column b)
For Each evalCell In evalRange
If evalCell.MergeCells <> True Then
' Assign the counter to the column at the left (offset = -1) of the evaluated cell
evalCell.Offset(rowoffset:=0, columnOffset:=-1).Value2 = counter
counter = counter + 1
End If
Next evalCell
End Sub
I was trying to write a basic loop that finds a unique value in a specific column in my worksheet. I believe that I have declared my variables properly. However, when I attempt to run my code, it gives me an overflow error. All I want is for my macro to be able to loop through my data set until it finds the specific ID Number.
Below is my Code for facilitated viewing:
Sub Macro1()
Dim FirstRow As Range
Dim LastRow As Range
Dim R As Long
FirstRow = Worksheets("Petrobras").Range("V2")
LastRow = Worksheets("Petrobras").Cells(Rows.Count, 22).End(xlUp).Select
R = TXTOPPNUM_Insert.Value
For R = FirstRow To LastRow
Worksheets("Petrobras").Cells(Rows.Count, 22).Find(R, , , Lookat:=xlWhole).Select
Next R
End Sub
Here is what may help:
Sub Macro1()
Dim FirstRow As Long
Dim LastRow As Long
Dim R As Long
Dim tempStore As New collection ' collection is initialized with .Count = 0
Dim uniqueValue As Variant
' is that needed?
'R = TXTOPPNUM_Insert.Value
With Worksheets("Petrobras")
FirstRow = .Cells(2, 22).row ' set first row
LastRow = .Cells(Rows.Count, 22).End(xlUp).row ' set last row
For R = FirstRow To LastRow ' there's an actual loop
If Application.WorksheetFunction.CountIf(range(.Cells(FirstRow, 22), .Cells(LastRow, 22)), .Cells(R, 22).Value) = 1 Then ' don't think that I have to explain how does the CountIf works
tempStore.Add .Cells(R, 22).Value ' if the CountIf of value = 1 then adding this value to a collection
End If
Next
If tempStore.Count > 1 Then ' if collection contains more that 1 value - means that there is not one unique value
MsgBox "There is more then 1 unique value"
Else
uniqueValue = tempStore(1) ' if collection contains 1 value - assign the unique value variable
End If
End With
End Sub
Also, look carefully to this article and this one.
To keep your code simple, you can use a one-liner that can be activated using a Button_Click on your userform; just add this line of code to the Button_Click macro. Type the value you are looking for into the textbox and click the button.
ThisWorkbook.Sheets("Petrobras").Range("V2", Range("V" & Rows.Count).End(xlUp)).Find(What:=Me.TXTOPPNUM_Insert.Value).Select
How can I place a formula in the first empty cell on Column F?
F3 is empty cell.
Need for that empty cell be =F2
Note: I'm looking for code to look for first empty cell F and I need to be able to insert in the first empty cell =F3.
Currently working with following code copied from here
Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim currentRowValue As String
sourceCol = 6 'column F has a value of 6
rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row
'for every row, find the first blank cell and select it
For currentRow = 1 To rowCount
currentRowValue = Cells(currentRow, sourceCol).Value
If IsEmpty(currentRowValue) Or currentRowValue = "" Then
Cells(currentRow, sourceCol).Select
Exit For 'This is missing...
End If
Next
Your existing code implies you want to consider truely Empty cells and cells that contain an empty string (or a formula that returns an empty string) Note 1. (Given you simply copied that code from elsewhere, that may not be the case)
You can use End(xlDown) to locate the first truely Empty cell, or Match to locate the first "Empty" cell in a range (either just empty string, or either empty strings or Empty cells, in different forms)
If you want to find the first truely Empty cell, or cell containing an empty string:
Function FindFirstEmptyOrBlankCell(StartingAt As Range) As Range
Dim rng As Range
'Set search range
With StartingAt.Worksheet
Set rng = .Range(StartingAt, .Cells(.Rows.Count, StartingAt.Column).End(xlUp).Offset(1, 0))
End With
' Find first empty or blank cell
Set FindFirstEmptyOrBlankCell = rng.Cells(StartingAt.Worksheet.Evaluate("Match(True, " & rng.Address & "=""""" & ", 0)"), 1)
End Function
If you want to find the first truely Empty cell, and ignore cells containing an empty string:
Function FindFirstEmptyCell(StartingAt As Range) As Range
Dim rng As Range
'Set search range
With StartingAt.Worksheet
Set rng = .Range(StartingAt, .Cells(.Rows.Count, StartingAt.Column).End(xlUp).Offset(1, 0))
End With
' Find first empty cell
If IsEmpty(StartingAt.Cells(1, 1)) Then
Set FindFirstEmptyCell = rng.Cells(1, 1)
ElseIf IsEmpty(StartingAt.Cells(2, 1)) Then
Set FindFirstEmptyCell = rng.Cells(2, 1)
Else
Set FindFirstEmptyCell = rng.End(xlDown).Cells(2, 1)
End If
End Function
And for completeness, if you want to find the fisrt cell containing an empty string, and ignore truely Empty cells:
Function FindFirstBlankCell(StartingAt As Range) As Range
Dim rng As Range
Dim idx As Variant
'Set search range
With StartingAt.Worksheet
Set rng = .Range(StartingAt, .Cells(.Rows.Count, StartingAt.Column).End(xlUp).Offset(1, 0))
End With
' Find first blank cell
idx = Application.Match(vbNullString, rng, 0)
If IsError(idx) Then
'There are no Blank cells in the range. Add to end instead
Set FindFirstBlankCell = rng.Cells(rng.Rows.Count, 1)
Else
Set FindFirstBlankCell = rng.Cells(idx, 1)
End If
End Function
In all cases, call like this
Sub Demo()
Dim ws As Worksheet
Dim r As Range
Set ws = ActiveSheet '<~~~ or specify required sheet
Set r = FindFirstEmptyOrBlankCell(ws.Range("F3"))
' literally what was asked for
'r.Formula = "=F3"
' possibly what was actually wanted
r.Formula = "=" & r.Offset(-1, 0).Address(0, 0)
End Sub
Note 1
If IsEmpty(currentRowValue) Or currentRowValue = "" Then is actually redundant. Any value that returns TRUE for IsEmpty(currentRowValue) will also return TRUE of currentRowValue = "" (The reverse does not apply)
From comment can that same Fuction repeat until the last empty cel? I think this is what you mean is to continue to fill blank cells down through the used range
If so, try this
Sub Demo()
Dim ws As Worksheet
Dim cl As Range
Dim r As Range
Set ws = ActiveSheet '<~~~ or specify required sheet
Set cl = ws.Range("F3")
Do
Set r = FindFirstEmptyOrBlankCell(cl)
If r Is Nothing Then Exit Do
r.Formula = "=" & r.Offset(-1, 0).Address(0, 0)
Set cl = r.Offset(1, 0)
Loop
End Sub
Note, I've modified FindFirstEmptyOrBlankCell above to aloow it to return Nothing when it needs to:
Function FindFirstEmptyOrBlankCell(StartingAt As Range) As Range
Dim rng As Range
'Set search range
With StartingAt.Worksheet
Set rng = .Range(StartingAt, .Cells(.Rows.Count, StartingAt.Column).End(xlUp).Offset(1, 0))
End With
' Find first empty or blank cell
On Error Resume Next ' Allow function to return Nothing
Set FindFirstEmptyOrBlankCell = rng.Cells(StartingAt.Worksheet.Evaluate("Match(True, " & rng.Address & "=""""" & ", 0)"), 1)
End Function
You'll need to change your rowCount, the way you have it, the loop will stop before the first blank row. I believe you should just be able to set use .Formula for the empty cell. Hope this helps:
Sub EmptyCellFillFormula()
Dim sourceCol As Integer, rowCount As Integer, currentRow As Integer
Dim currentRowValue As String
sourceCol = 6 'column F has a value of 6
rowCount = Cells(Rows.Count, sourceCol).End(xlUp).Row + 1
For currentRow = 1 To rowCount
currentRowValue = Cells(currentRow, sourceCol).Value
If IsEmpty(currentRowValue) Or currentRowValue = "" Then
Cells(currentRow, sourceCol).Formula = "=F3"
End If
Next
End Sub
I have an advanced filter set up and separate to that subroutine I have another subroutine that loops through the filter results and places the value into a text box. That all works fine but I'm trying to include a counter so for every result that's being displayed the counter goes up, and then when the criteria changes and new results are found it goes back to 1 and counts again from there.
Public Sub GetNextResult()
FilterData
Dim ws As Worksheet
Set ws = ThisWorkbook.Worksheets("Database")
Dim header As String
header = "txtbox1"
Dim LastRow As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
Dim DataRange As Range
Set DataRange = ws.Range("A5", "H" & LastRow)
Dim FilteredData As Range
Set FilteredData = DataRange.Resize(ColumnSize:=1).SpecialCells(xlCellTypeVisible)
If CurrentRow + 1 > FilteredData.Cells.Count Then
CurrentRow = 1
End If
CurrentRow = CurrentRow + 1
Dim i As Long
Dim cell As Variant
Dim counter As Integer
counter = 1
For Each cell In FilteredData
i = i + 1
If i = CurrentRow Then
Call ShowAll
TextboxName = "txtbox1"
ActiveSheet.Shapes(TextboxName).DrawingObject.Text = cell.Offset(0, 2)
TextboxName2 = "txtbox2"
ActiveSheet.Shapes(TextboxName2).DrawingObject.Text = cell.Offset(0, 3)
TextboxName3 = "Cardcounter"
ActiveSheet.Shapes(TextboxName3).DrawingObject.Text = counter
If ActiveSheet.Shapes(TextboxName).DrawingObject.Text = header Then
'MsgBox "header detected"
'Exit Sub
Call GetNextResult
End If
Call quick_artwork
counter = counter + 1
Else
Call ShowAll
'Exit Sub
'MsgBox "No data found matching this criteria"
'TextboxName = "txtbox1"
'ActiveSheet.Shapes(TextboxName).DrawingObject.Text = "No data found matching this criteria"
'TextboxName2 = "txtbox2"
'ActiveSheet.Shapes(TextboxName2).DrawingObject.Text = ""
End If
Next cell
End Sub
So I've put counter = 1 before the for loop and then within the for loop I've put counter = counter + 1 and I thought that would work but it doesn't. It doesn't show an error, but the number doesn't change.
Any help would be appreciated!
You could declare counter outside the GetNextResult() routine, and set it to 1 before calling the GetNextResult() routine.
Dim counter As Integer
Sub SomeOtherSubCallingGetNextResult()
...
counter = 1
GetNextResult
...
End sub