In the below code I found the column number of the values in the array. How to use that range to compare values to a with a variable?
Public Sub JpFee()
Dim rng As Range, rws As Long, w As Long, Str As Variant, Count As Integer, x(20) As Integer, Lt() As Variant, ht As Variant, Wdt As Variant, W8t As Variant
Dim row1, i, y As Integer
row1 = ActiveSheet.UsedRange.Rows.Count
MsgBox row1
Str = Array("length (cm)", "width (cm)", "height (cm)", "unit weight(kg)", "surface area L+W+H", "size")
For w = LBound(Str) To UBound(Str)
Set rng = Rows("1:1").Find(What:=Str(w), LookAt:=xlWhole, MatchCase:=False)
x(i) = rng.Column
i = i + 1
MsgBox rng.Column
Next w
End Sub
I would use a collection for something like this. You could also use a dictionary. (Whichever you prefer).
Here's an example of using a collection with what you're trying to do:
Sub tgr()
Dim ws As Worksheet
Dim HeaderCell As Range
Dim cHeaders As Collection
Set ws = ActiveWorkbook.ActiveSheet
Set cHeaders = New Collection
On Error Resume Next 'Collections will error if there are duplicates, this prevents that error
'Loop through each headercell
For Each HeaderCell In ws.Range("A1").CurrentRegion.Resize(1).Cells
'If the headercell contains text, add its column number to the collection and set the key to the headertext
If Len(HeaderCell.Text) > 0 Then cHeaders.Add HeaderCell.Column, CStr(HeaderCell.Text)
Next HeaderCell 'Advance the loop
On Error GoTo 0 'Clear the On Error Resume Next condition
'Now you can get the column number of a known header by referencing the header in your collection
'This will show the column number of the header "size"
'Note that the header does not need to be case sensitive, but must be the exact text
MsgBox cHeaders("size")
'So if you want to put in a value in the bottom row of a column:
ws.Cells(ws.Rows.Count, cHeaders("size")).End(xlUp).Offset(1).Value = 2
End Sub
Related
I'm trying to check a range of cells for the value "X" and when the column name where the "X" was found is among an array I have previously specified, I want to have a helper column that would say TRUE otherwise say FALSE.
To illustrate, here's a sample table:
In my sample, I have this array that contains 3 values ( Math, English and History). If there is an X in any of the rows whose header name is in the array, I want the helper column to say TRUE otherwise FALSE. It doesn't have to be all of the values in the array, it can be at least only one.
Here is my code (my original file has more columns than my sample, so my code is liek this)
Sub add_helper()
' Adding helper column
Dim checking As Variant
checking = check_issue() -- this is another function, basically checking will contain the values I want to check in this case Math, English and History, i have confirmed this gets it successfully
Dim wks As Worksheet
Set wks = ActiveSheet
Dim rowRange As Range
Dim colRange As Range
Dim LastCol As Long
Dim LastRow As Long
LastRow = wks.Cells(wks.Rows.Count, "I").End(xlUp).row
Set rowRange = wks.Range("I2:AD" & LastRow)
Set colRange = wks.Range("I1:AD1")
'Loop through each row
For Each rrow In rowRange
Do
For Each cell In colRange
'Do something to each cell
If InStr(checking, cell.value) > 0 Then
If Cells(rrow.row, rrow.Column).value <> "" Then
wks.Range("AI" & rrow.row).value = "TRUE"
Exit For
Else
wks.Range("AI" & rrow.row).value = "FALSE"
End If
End If
Next cell
Loop Until wks.Range("AI" & rrow.row).value <> "TRUE"
Next rrow
End Sub
My code results to just having an input of true whenever there is an X without actually checking if the header column is in my array.
Did you try normal formulas in Excel? You could create a table (a ListObject) with the courses as your array values and the combine SUMPRODUCT with COUNTIF to output True/False in your helper column. Easy to update and adapt:
Notice the table at most right named T_COURSES. The formula in helper column is:
=SUMPRODUCT(--(COUNTIF(T_COURSES,$B$1:$E$1)>0)*--(B2:E2="x"))>0
It works perfectly and it autoupdates changing values:
Match Headers of Matches Against Values in Array
Option Explicit
Sub AddHelper()
Dim checking As Variant: checking = check_issue()
Dim ws As Worksheet: Set ws = ActiveSheet ' improve!
Dim hrg As Range: Set hrg = ws.Range("I1:AD1") ' Header Range
Dim drg As Range ' Data Range
Set drg = ws.Range("I2:AD" & ws.Cells(ws.Rows.Count, "I").End(xlUp).Row)
Dim crg As Range: Set crg = drg.EntireRow.Columns("AI") ' (Helper) Column Range
crg.Value = False
Dim rrg As Range, rCell As Range, r As Long, c As Long, IsFound As Boolean
For Each rrg In drg.Rows
r = r + 1 ' for the (helper) column range
c = 0 ' for the header range
For Each rCell In rrg.Cells
c = c + 1
If StrComp(CStr(rCell.Value), "x", vbTextCompare) = 0 Then
If IsNumeric(Application.Match(CStr(hrg.Cells(c)), checking, 0)) _
Then IsFound = True: Exit For
End If
Next rCell
If IsFound Then crg.Cells(r).Value = True: IsFound = False
Next rrg
End Sub
Col B on "Sheet2" contains 370 rows of data.
Starting with "Sheet2" Cell B1, I want to search for a matching value in Col B on "Sheet1" (it could be located anywhere in the first 300 rows of "Sheet1" Col B).
If a match is found, copy the entire row from "Sheet1" and paste to Row1 on "Sheet2". Then, move to "Sheet2" Cell B2 and repeat the search, this time pasting the entire row from "Sheet1" to Row2 on "Sheet2". Continue moving thru the entire column of data on "Sheet2", searching for each cell's value on "Sheet1". If a search doesn't return a match, then do not paste anything to that row on "Sheet2" and just proceed to search for the next cell on "Sheet2". (For example, if Sheet1 Col B doesn't contain a match for Sheet2 Cell B3, then nothing gets pasted in Sheet2 Row3.)
I have found the following example, which starts to help me, but it specifies the search value and doesn't loop thru the entire column of values like I am attempting to do.
Sub CopyYes()
Dim c As Range
Dim j As Integer
Dim Source As Worksheet
Dim Target As Worksheet
' Change worksheet designations as needed
Set Source = ActiveWorkbook.Worksheets("Sheet1")
Set Target = ActiveWorkbook.Worksheets("Sheet2")
J = 1 ' Start copying to row 1 in target sheet
For Each c In Source.Range("E1:E1000") ' Do 1000 rows
If c = "yes" Then
Source.Rows(c.Row).Copy Target.Rows(j)
j = j + 1
End If
Next c
End Sub
This should do the trick, and do it fast:
Option Explicit
Sub CopyYes()
'You need Microsoft Scripting Runtime library under Tools-References for this
Dim arrPaste As Variant: arrPaste = Sheet2.UsedRange.Value
Dim arrCopy As Variant: arrCopy = Sheet1.UsedRange.Value
Dim MyMatches As New Dictionary: Set MyMatches = CreateDictionary(arrCopy)
Dim i As Long
For i = 1 To UBound(arrPaste)
If arrPaste(i, 2) = vbNullString Then Exit For
If MyMatches.Exists(arrPaste(i, 2)) Then PasteData arrPaste, arrCopy, i, MyMatches(arrPaste(i, 2))
Next i
Sheet2.UsedRange.Value = arrPaste
Erase arrCopy
Erase arrPaste
End Sub
Private Function CreateDictionary(arr As Variant) As Dictionary
Dim i As Long
Set CreateDictionary = New Dictionary
For i = 1 To 300
CreateDictionary.Add arr(i, 2), i
Next i
End Function
Private Sub PasteData(arrPaste As Variant, arrCopy As Variant, i As Long, MyMatch As Long)
Dim j As Long
For j = 1 To UBound(arrCopy, 2)
If arrCopy(MyMatch, j) = vbNullString Then Exit For
arrPaste(i, j) = arrCopy(MyMatch, j)
Next j
End Sub
Use Range.Find to search for your matching cell
Use a Union to create a collection of the rows that are found
Once your loop is finished, copy your range all at once if the Union is not empty
Sub Shelter_In_Place()
Dim Source As Worksheet: Set Source = ThisWorkbook.Sheets("Sheet1")
Dim Target As Worksheet: Set Target = ThisWorkbook.Sheets("Sheet2")
Dim Found As Range, lr As Long
Dim CopyMe As Range
lr = Target.Range("B" & Target.Rows.Count).End(xlUp).Row
For i = 1 To lr
Set Found = Source.Range("B:B").Find(Target.Range("B" & i), LookIn:=xlWhole)
If Not Found Is Nothing Then
If Not CopyMe Is Nothing Then
Set CopyMe = Union(CopyMe, Target.Range("B" & i))
Else
Set CopyMe = Target.Range("B" & i)
End If
End If
Set Fouund = Nothing
Next i
If Not CopyMe Is Nothing Then
CopyMe.EntireRow.Copy
Source.Range("A1").PasteSpecial xlPasteValues
End If
End Sub
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'm trying to get all my filtered data in one range variable but it doesn't work.
When the visible datas are continuous (rows 25 to 200), i've no problem but when the visible datas are discontinuous (rows 25 to 27, then 43 to 47, then 60 to 92) it only get the first range (rows 25 to 27)
Here is my code :
datas = dataSheet.Range("A2:L" & dataSheet.
[A65000].End(xlUp).Row).SpecialCells(xlCellTypeVisible).Value
Do you have any tip ?
Thank you for your answer.
Louis
It sounds like you're trying to populate an array variable named datas, which is successful if your range is continuous, but only gets the first section when discontinuous. And what you're looking for is to populate the array with all of the data from the discontinuous range.
That is possible, and there are two approaches. The first is to copy the discontinuous range and paste it into a temp worksheet. The pasted range will be continuous and then you can load it into the array normally as shown in your original code. The second is to populate the array directly, but you'll have to loop through each visible cell to do this.
Method 1 (use temp worksheet):
Sub tgrTempWS()
Dim dataSheet As Worksheet
Dim tempSheet As Worksheet
Dim rData As Range
Dim datas As Variant
Set dataSheet = ActiveWorkbook.Sheets("Sheet1")
On Error Resume Next
Set rData = dataSheet.Range("A2:L" & dataSheet.[A65000].End(xlUp).Row).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rData Is Nothing Then Exit Sub 'No data
Set tempSheet = dataSheet.Parent.Sheets.Add
rData.Copy tempSheet.Range("A1")
datas = tempSheet.Range("A1").CurrentRegion.Value
Application.DisplayAlerts = False
tempSheet.Delete
Application.DisplayAlerts = True
'do stuff with your datas array variable here
End Sub
Method 2 (loop through visible cells):
Sub tgrLoop()
Dim dataSheet As Worksheet
Dim rData As Range
Dim rCell As Range
Dim datas As Variant
Dim lRow As Long, lCol As Long
Dim i As Long, j As Long
Set dataSheet = ActiveWorkbook.Sheets("Sheet1")
On Error Resume Next
Set rData = dataSheet.Range("A2:L" & dataSheet.[A65000].End(xlUp).Row).SpecialCells(xlCellTypeVisible)
On Error GoTo 0
If rData Is Nothing Then Exit Sub 'No data
ReDim datas(1 To Intersect(rData, rData.Areas(1).Resize(, 1).EntireColumn).Cells.Count, 1 To rData.Columns.Count)
For Each rCell In rData.Cells
If lRow = 0 Then
lRow = rCell.Row
i = 1
ElseIf rCell.Row > lRow Then
i = i + 1
lRow = rCell.Row
End If
If lCol = 0 Or rCell.Column < lCol Then
lCol = rCell.Column
j = 1
ElseIf rCell.Column > lCol Then
j = j + 1
lCol = rCell.Column
End If
datas(i, j) = rCell.Value
Next rCell
'do stuff with your datas array variable here
End Sub
From MSDN about Range Object : "Represents a cell, a row, a column, a selection of cells containing one or more contiguous blocks of cells, or a 3-D range."
That's why you only get the first range. Have a look at this page to refer to multiple ranges.
Seeking a method in Excel VBA to Find last row number where column "C" contains a known value.
This will find the last occurrence of happiness in column C
Sub SeekHappiness()
Dim C As Range, where As Range, whatt As String
whatt = "happiness"
Set C = Range("C:C")
Set where = C.Find(what:=whatt, after:=C(1), searchdirection:=xlPrevious)
MsgBox where.Address(0, 0)
End Sub
To output the row number only, use:
MsgBox Mid(where.Address(0, 0), 2)
To find the first occurrence:
Sub SeekHappiness()
Dim C As Range, where As Range, whatt As String
whatt = "happiness"
Set C = Range("C:C")
Set where = C.Find(what:=whatt, after:=C(1))
MsgBox where.Address(0, 0)
End Sub
You could loop through the column to find the last occurrence of a value.
Sub findLastRow()
Dim searchValue As String
Dim endRow As Integer
Dim lastRowSearchValue As Integer
searchValue = "testValue" ''enter your search value
With Worksheets("sheet1") ''enter the name of your worksheet
endRow = .Cells(Rows.Count, 3).End(xlUp).Row
For i = 1 To endRow
If .Cells(i, 3) = searchValue Then
lastRowSearchValue = i
End If
Next i
End With
End Sub
Just replace the value of the variable "searchValue" with whatever is the value you're looking for (maybe change the type of the variable if its not a string) and the Sub will store the index of the last row of the occurrence of the searchValue in the variable "lastRowSearchValue" for further use.
Sub GetRo()
'Either select data or replace selection with your range
Debug.Print Selection.Find(what:="mysring", searchdirection:=xlPrevious).Row
End Sub