I am currently looking for the following issue. I would like to find every position of a particular matches and store them into a vector called pos. In my example I would like to know every row in the range(E1:E500) where "SG" appears. Then I would like to loop through this vector.
I have tried the following code but it seems not to work. Can anyone help me?
Sub test()
Set rangenew = Range("E1:E500")
pos = Application.Match("SG", rangenew, False)
End Sub
the results should be something like
pos = (1,6,8,10)
Then I would like to loop through this vector to test conditions.
Thanks for your great help.
As #GSerg explained in the comments, there is no built-in function for returning matched row numbers. Something like the below should do what you're after.
Public Sub getRows()
Dim wb As Workbook, ws As Worksheet
Dim checkData() As Variant, pos() As Long
Dim i As Long
Dim matchCount As Long
Set wb = ThisWorkbook
Set ws = wb.Sheets(1)
checkData = ws.Range("E1:E500")
For i = LBound(checkData, 1) To UBound(checkData, 1)
If checkData(i, 1) = "SG" Then
matchCount = matchCount + 1
ReDim Preserve pos(1 To matchCount)
pos(matchCount) = i
End If
Next i
End Sub
Related
As I am working with large csv files, I decided to load them into VBA memory instead of loading in my spreadsheet to make it quicker and lighter.
So I have a function CSVtoArray that read through my CSV and gives me an array.
Then if I still want to see my data in excel I just write {=(CSVtoArray(my_csv_path)} in my s/s.
But since the size of my csv changes over time, I wanted to write a function called AutoRange that would automatically fit the display area in my spreadsheet according to the size of my range.
So this is what I wrote but it's not working, it does nothing, only the cell in which I am writing the formula is filled.
Function AutoRange(my_array As Variant)
Dim nb_rows, nb_cols As Integer
Dim current_cell, target_range As Range
nb_rows = UBound(my_array, 1)
nb_cols = UBound(my_array, 2)
Set current_cell = Selection
current_cell.Resize(nb_rows, nb_cols).FormulaArray = current_cell.Formula
AutoRange = Selection
End Function
Thanks in advance guys.
Functions are for returning things. And if used in the cell are for returning things to that cell, not to manipulate other cells. Do you want actually want a sub like?
Code:
Option Explicit
Public Sub TEST()
Dim my_Array()
my_Array = [A1].CurrentRegion.Value
AutoRange my_Array
End Sub
Public Sub AutoRange(ByVal my_Array As Variant)
Dim nb_rows As Long, nb_cols As Long
Dim current_cell As Range
nb_rows = UBound(my_Array, 1)
nb_cols = UBound(my_Array, 2)
Set current_cell = Selection
current_cell.Resize(nb_rows, nb_cols).FormulaArray = current_cell.Formula
End Sub
Result:
From your comments: If you want to use as a function (Not a UDF, which cannot alter other cells) then you can use the following way, though I advise against it as it bad practice:
Option Explicit
Public Sub TEST()
Dim my_Array()
my_Array = [A1].CurrentRegion.Value
Dim target_Range As Range
Set target_Range = AutoRange(my_Array)
End Sub
Public Function AutoRange(ByVal my_Array As Variant) As Range
Dim nb_rows, nb_cols As Long
Dim current_cell, target_Range As Range
nb_rows = UBound(my_Array, 1)
nb_cols = UBound(my_Array, 2)
Set current_cell = Selection
Set target_Range = current_cell.Resize(nb_rows, nb_cols)
Set AutoRange = target_Range
target_Range.FormulaArray = current_cell.Formula
End Function
Ok so I did it another way,
I have my AutoRange sub :
Sub AutoRange(my_Array As Variant, top_left_corner As Range)
' Here we take an array in input, the one we want to display, and the top left corner of the range where we want to put it
Dim nb_rows, nb_cols As Integer
nb_rows = UBound(my_Array, 1)
nb_cols = UBound(my_Array, 2)
Set current_cell = top_left_corner
top_left_corner.Resize(nb_rows, nb_cols).FormulaArray = top_left_corner.Formula
End Sub
and then I added a Worksheet_change sub to my s/s:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
if Target.value="load data" then
Call Autorange(my_array, my_range)
else
Range(my_range, my_range.End(xlDown).End(xlToRight)).clearcontents
End If
End Sub
so I just need to say if I want to load my data or not and it will adjust.
I assume that at my former company they were using an addin rather than VBA itself.
thanks anyways guys.
cheers
I have an issue with my VBA script which I'm not able to resolve, despite of all the researches I've made (Indeed, I tried to modify all the vba scripts which were near what I'm looking for, but it doesn't work).
Thank you very much for your help !
I have 2 sheets.
For the first one (ActiveSheet), I have a list.
For example :
Beurre
Creme fraiche
Fromage
Oeufs
Yaourts
In the second one ("Add value"), I have this list :
Chocolat
Carotte
Haricot
Fromage
Endive
I want the script to verify if the first value which is the sheet ("Add Value") exists in the ActiveSheet.
If it doesn't, it takes the second value in "Add Value" to make this verification. And so on with the other lines.
The loop has to stop when the script finds the same value. Then it does an action (MsgBox, for example).
For example, when the script researches "Chocolat" (the first line of the sheet "Add Value") in the ActiveSheet, it won't find it : it will use the second word to make this reasearch until it uses world "Fromage" which also exist in the second sheet.
It does the action (the msgbox), then quit the loop to continue with the other called macro which are in the script.
Moreover, I would like to choose the columns of the cell from "Add Value" each time I call the macro. Indeed, there will be several lists in this sheet.
Here is my macro. The issue is that I get the error 424 on the ligne If Not FindString Is Nothing Then
Public Sub Var()
Dim plage As Variant
Set plage = ActiveSheet.Range("A:A")
Dim col As Integer
Dim Ligne As Integer
Set Ligne = 2
Dim FindString As String
Set FindString = ThisWorkbook.Sheets("Add Value").Cells(Ligne, col).Value
End Sub
Sub Boucle_Ajout(col)
With plage
Do
If Not FindString Is Nothing Then
'do
Else
Ligne = Ligne + 1
End If
Loop While Not FindString Is Nothing
End With
End Sub
Then when I call the Macro, I only have to choose the column.
For example :
Call Boucle_Ajout(1)
Thank you very much for your help, because I am sick of not finding the solution.
PS : sorry for my english, I'm french.
Assuming the lines without numbers are in A1 to A5, this works:
Option Explicit
Const THECOLUMN = "A1"
Sub FindLineInOtherSheet()
Dim activeSheetRange As Range
Dim addValueRange As Range
Dim activeSheetLastRow As Integer
Dim addValueLastRow As Integer
Dim i As Integer
Dim n As Integer
Dim activeSheetCell As String
Dim addValueCell As String
'*
'* Setup
'*
Set activeSheetRange = ThisWorkbook.Sheets("activeSheet").Range(THECOLUMN)
activeSheetLastRow = findLastRow("activeSheet", THECOLUMN)
addValueLastRow = findLastRow("addValue", THECOLUMN)
'*
'* Loop through each cell in addValue for each cell in activeSheet
'*
For i = 1 To activeSheetLastRow
Set addValueRange = ThisWorkbook.Sheets("addValue").Range(THECOLUMN)
activeSheetCell = activeSheetRange.Value
For n = 1 To addValueLastRow
addValueCell = addValueRange.Value
If addValueCell = activeSheetCell Then
MsgBox ("Trouvé " & addValueCell)
End If
Set addValueRange = addValueRange.Offset(1, 0) 'Next row
Next n
Set activeSheetRange = activeSheetRange.Offset(1, 0)
Next i
End Sub
Function findLastRow(Sheetname As String, ColumnName As String) As Integer
Dim lastRow As Integer
Dim r As Range
Dim WS As Worksheet
Set WS = Worksheets(Sheetname)
lastRow = WS.UsedRange.Rows.Count
'*
'* Search backwards till we find a cell that is not empty
'*
Set r = WS.Range(ColumnName).Rows(lastRow)
While IsEmpty(r)
Set r = r.Offset(-1, 0)
Wend
lastRow = r.Row
Set WS = Nothing
findLastRow = lastRow
End Function
I am trying to write a For...Next loop to create a set number of Worksheets in a Workbook. The the number of worksheets is set by the user from a dashboard, at an earlier point.
Can somebody point me in the right direction? This is my code, so far:
For i = 1 To siteCount
'I know the below won't work, and I also tried site_ & i, but no luck
Set site_i = Sheets.Add(after:=Sheets(Worksheets.Count))
site_i.Name = "Sheet Name"
Next i
With some small adjustments, your code will basically work:
Option Explicit
Sub AddSheets()
Dim siteCount As Integer
Dim i As Integer
Dim site_i As Worksheet
siteCount = 4
For i = 1 To siteCount
Set site_i = Sheets.Add(after:=Sheets(Worksheets.Count))
site_i.Name = "Sheet_Name_" & CStr(i)
Next i
End Sub
I have an If/Then loop in VBA that checks if the same cell in each tab are equal, and I can create a string that works in the If/Then loop given a known number of tabs (3 tabs); however, the macro needs to look at an arbitrary number of tabs and I need a dynamic If/Then statement. I tried to create a string that essentially writes the code based on the number of tabs, but I get Type Mismatch because the string is a variable.
For example, this works given 3 tabs:
If Worksheets(loc(1)).Cells(TseriesLine, 15) = Worksheets(loc(2)).Cells(TseriesLine, 15) _
And Worksheets(loc(1)).Cells(TseriesLine, 15) = Worksheets(loc(3)).Cells(TseriesLine, 15) Then
....
But this doesn't work:
ifline = "Worksheets(loc(1)).Cells(TseriesLine, 15) = Worksheets(loc(2)).Cells(TseriesLine, 15) _
And Worksheets(loc(1)).Cells(TseriesLine, 15) = Worksheets(loc(3)).Cells(TseriesLine, 15)"
If ifline Then ....
I also tried using Evalulate(ifline) and StrConv(ifline) to no success. Any help would be appreciated.
Thanks
Try something like this.
You can easily test against other sheet names if there are sheets you know you don't want to check against.
Dim sValue As String
Dim ws1 As Worksheet
Set ws1 = Worksheets("loc(1)")
sValue = ws1.Cells(TseriesLine, 15).Value2
Dim bifline As Boolean
bifline = True
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> ws1.Name Then
If sValue <> ws.Cells(TseriesLine, 15).Value2 Then
bifline = False
Exit For
End
End If
Next
If bifline Then
'more code
End If
You can loop over each sheet with the worksheet collection in each workbook object.
Function doesRangeMatch(rangeAddress As String) As Boolean
Dim ws As Worksheet
For Each ws In ThisWorkbook.Worksheets
If ThisWorkbook.Worksheets(1).Range(rangeAddress).Value <> ws.Range(rangeAddress).Value Then
doesRangeMatch = False
Exit Function 'early exit if match not found
End If
Next
doesRangeMatch = True 'if loop goes through then all must match
End Function
Thanks everyone so much! I used a combination of suggestions to come up with the loop. Here is the solution:
For ss = 2 To numloc
If Worksheets(loc(1)).Cells(TseriesLine, 15) <> Worksheets(loc(ss)).Cells(TseriesLine, 15) Then
doNumMatch = False
Exit For
Else: doNumMatch = True
End If
Next
If doNumMatch Then
I have a workbook that comes from someone else so the file path is referring to that person's local drive. So I need to replace the file path with the one in my local drive. I tried 3 methods and they all failed. Please give me some guidelines. Basically, I am trying to find a replace 2 file paths within a formula for an entire sheet (almost all the cells) (see below):
='U:\Futochan\2012\[Futochan2012.xlsm]Counts'!E6+'U:\Futochan\2013\[Futochan2013.xlsm]Counts'!E6
1st Method:
Did this manually. DAta -> Edit Links -> Change sources (Failed, keep prompted me for the links)
2nd Method:
VBA: Did the range.replace. It only replaced the first cell and halted.
3rd Method:
VBA: Did a cell by cell loop :"For each cell in range". I turned off everything. It worked but took 2 hours. :/
Please help!! Thanks!
Firstly, any reason why you can't do a manual find and replace all for "U:\Futochan\2012[Futochan2012.xlsm]"? If it is just two links, and this is a one-off, this is by far the quickest approach.
For Range.replace, what was your range? If you call it on Worksheet.Cells.replace(...) it should replace all instances.
Finally, a quick approach that does not involve Range.Replace is below, but again, reinventing the wheel is a less than preferable approach :)
Private stringsToReplace As New Collection
Sub blah()
Dim ws As Worksheet
Dim arr
Dim formulaCells As Range, area As Range
Dim i As Long, j As Long
stringsToReplace.Add Array("old1", "new1") 'add as many pairs as you like in the format of Array(oldString,newString)
Set ws = ActiveSheet
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
On Error Resume Next
Set formulaCells = ws.Cells.SpecialCells(xlCellTypeFormulas) 'only look at formula cells for speed
On Error GoTo 0
If Not formulaCells Is Nothing Then
For Each area In formulaCells 'we will load into an array in memory, to prevent the horrendously slow enumeration through cells
If area.Count = 1 Then
area.Formula = newFormulaText(area.Formula)
Else
arr = area.Formula
For i = LBound(arr, 1) To UBound(arr, 1)
For j = LBound(arr, 2) To UBound(arr, 2)
arr(i, j) = newFormulaText(arr(i, j))
Next j
Next i
area.Formula = arr
End If
Next area
End If
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
End Sub
Function newFormulaText(ByVal oldText As String) As String
Dim oldNewPair
Dim newText As String
newText = oldText
For Each oldNewPair In stringsToReplace
newText = Replace(newText, oldNewPair(0), oldNewPair(1))
Next oldNewPair
newFormulaText = newText
End Function