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
Related
I'm new to VBA and am trying to cobble together some code to allow a user to input a word (or several words) into a cell and then show a list of matching row entries.
I have tried the following code but am getting an "instring = type mismatch" error.
Note that "B3" is the field dedicated for the "search word" and column F is the column containing the text I want to search within. If the word is contained, I want to show that row and hide all rows that don't contain that word.
Sub Find_Possible_Task()
ROW_NUMBER = 0
SEARCH_STRING = Sheets("codeset").Range("B3")
ROW_NUMBER = ROW_NUMBER + 1
ITEM_IN_REVIEW = Sheets("codeset").Range("F:F")
If InStr(ITEM_IN_REVIEW, SEARCH_STRING) Then
Do
Cells(c.Row).EntireRow.Hidden = False
Loop Until ITEM_IN_REVIEW = ""
End If
End Sub
TIA!
Few bad coding conventions or even possibly downright errors:
It's a good practice to explicity declare the scope Public/Private of your Sub procedure
Unless you're passing the variables from some place else, they need to be declared with Dim keyword
Using Option Explicit will help you prevent aforementioned error(s)
(Subjective) variables in all caps are ugly and in most programming languages it is convention to reserve all caps variables names for constants (Const)
Option Explicit
Private Sub keep_matches()
Dim what As Range
Dim where As Range
Dim res As Range ' result
Dim lr As Long ' last active row
Dim ws As Worksheet: Set ws = Sheets("codeset")
lr = ws.Cells(ws.Rows.Count, "F").End(xlUp).Row
Set what = ws.Range("B3")
Set where = ws.Range("F1:F" & lr)
' we'll create an extra column for a loop in our .Find method
where.Copy
ws.Range("F1").EntireColumn.Insert
ws.Range("F1").PasteSpecial xlPasteValues
where.EntireRow.Hidden = True ' preemptively hide them all
Set where = ws.Range("F1:F" & lr)
Set res = where.Find(what, lookIn:=xlValues) ' ilook for matches, 1st attempt
If Not res Is Nothing Then ' if found
Do Until res Is Nothing ' repeat for all results
res.EntireRow.Hidden = False
res = "Checked"
Set res = where.FindNext(res)
Loop
Else
MsgBox("No matches were found")
where.EntireRow.Hidden = False ' we don't wanna hide anything
End If
ws.Range("F1").EntireColumn.Delete ' remove the extra help column for Find method
End Sub
Should work as expected.
If there are any question, let me know.
instead of instr(), consider range.find().
Sub Find_Possible_Task()
Dim SEARCH_STRING As String
Dim ITEM_IN_REVIEW As Range
Dim found As Range
Dim i As Integer
SEARCH_STRING = Sheets("Sheet1").Range("B3").Value
i = 1
Do
Set ITEM_IN_REVIEW = Sheets("Sheet1").Cells(i, 6)
Set found = ITEM_IN_REVIEW.Find(What:=SEARCH_STRING)
If found Is Nothing Then
ITEM_IN_REVIEW.EntireRow.Hidden = True
End If
i = i + 1
Loop Until ITEM_IN_REVIEW = ""
End Sub
alternatively, consider using filter table:
1. check if your table has filter on ==> if yes, pass. if no, turn on filter.
2. filter column F for keyword to contain value in cell B3.
Dim L As Double
Dim Workings() As Variant
Workings = Array("Due SO not Billed", "Working Paper", "Ageing Over 14 Days")
On Error Resume Next
Application.DisplayAlerts = False
For L = 1 To Worksheets.Count
If Worksheets(L).Name <> Workings Then
Worksheets(L).Delete
Exit For
End If
Next L
Application.DisplayAlerts = True
On Error GoTo 0
I tried writing above code. The purpose is I have 10 worksheets in a workbook but final output requires only 3 sheets and I want to delete the rest of the worksheets. I tried above code with array and whatever name I gave in the array should be saved and all other remaining sheets should be be deleted. I'm getting type mismatch error. Can someone help please?
Use Match to test whether the worksheet's Name is in the array:
Dim Workings() As Variant
Dim ws As Worksheet
Workings = Array("Due SO not Billed", "Working Paper", "Ageing Over 14 Days")
Application.DisplayAlerts = False
For Each ws In Worksheets
If IsError(Application.Match(ws.Name, Workings, False)) Then
ws.Delete
End If
Next
Application.DisplayAlerts = True
Smells like homework. It's not working because the Workings variable is an array while the other is a string, they are different types. To test if a string is inside an array do
If Not IsInArray(Worksheets(L).Name, Workings)
Function IsInArray(stringToBeFound As String, arr As Variant) As Boolean
IsInArray = (UBound(Filter(arr, stringToBeFound)) > -1)
End Function
Using VBA Filter function gives you the added benefit of comparing Text. In this way you do not have to be concerned with capitalization.
Sub DeleteWorksheets()
Dim Workings() As Variant
Dim ws As Worksheet
Workings = Array("Due SO not Billed", "Working Paper", "Ageing Over 14 Days")
Application.DisplayAlerts = False
For Each ws In Worksheets
If UBound(Filter(Workings, ws.Name, True, vbTextCompare)) = -1 Then ws.Delete
Next
Application.DisplayAlerts = True
End Sub
This is my valueInArray function:
Public Function valueInArray(myValue As Variant, myArray As Variant) As Boolean
Dim cnt As Long
For cnt = LBound(myArray) To UBound(myArray)
If CStr(myValue) = CStr(myArray(cnt)) Then
valueInArray = True
Exit Function
End If
Next cnt
End Function
It is quite a lot of code and it loops, but it works. Plus, it works ok for both integers and strings.
I need to be able to identify the worksheet that an excel chart (on a worksheet) is getting it's data from. I only need the data sheet which series 1 is referencing. I've started trying to extract the sheet name from .SeriesCollection(1).Formula but it gets realy complex. here's what I've got so far:
Sub GetChartDataSheet()
Dim DataSheetName As String
Dim DataSheet As Worksheet
DataSheetName = ActiveChart.SeriesCollection(1).Formula
DataSheetName = Left(DataSheetName, InStr(1, DataSheetName, "!$") - 1)
DataSheetName = WorksheetFunction.Replace(DataSheetName, 1, Len("=series("), "")
If Left(DataSheetName, 1) = "'" And Right(DataSheetName, 1) = "'" Then DataSheetName = Mid(DataSheetName, 2, Len(DataSheetName) - 2)
DataSheetName = Replace(DataSheetName, "''", "'")
Set DataSheet = Sheets(DataSheetName)
End Sub
this works in a lot of cases, but if my users have a strange worksheet name (eg Sh'e e$,,t!3!$) it fails. the same goes if series 1 has been named (eg .SeriesCollection(1).Formula = "=SERIES(**"Hell,o !"**,'Sh''e e$,,t!3!$'!$B$2:$B$18,'Sh''e e$,,t!3!$'!$C$2:$C$18,1)".
Is there a simple way to solve this?
I thought this is an easy one, turns out it's not. One of the cases where Excel has the information but will not give it away for free. I ended up with a function like this - maybe this helps:
Function getSheetNameOfSeries(s As Series) As String
Dim f As String, i As Integer
Dim withQuotes As Boolean
' Skip leading comma if not all parts of series is filled. Check if sheetname is in single quotes
For i = 9 To Len(s.Formula)
If Mid(s.Formula, i, 1) <> "," Then
If Mid(s.Formula, i, 1) = "'" Then
withQuotes = True
f = Mid(s.Formula, i + 1)
Else
withQuotes = False
f = Mid(s.Formula, i)
End If
Exit For
End If
Next i
' "f" now contains a part of the formula with the sheetname as start
' now we search to the end of the sheet name.
' If name is in quotes, we are looking for the "closing" quote
' If not in quotes, we are looking for "!"
i = 1
Do While True
If withQuotes Then
' Sheet name is in quotes, found closes quote --> we're done
' (but if next char is also a quote, we have the case the the sheet names contains a quote, so we have to continue working)
If Mid(f, i, 1) = "'" Then
If Mid(f, i + 1, 1) <> "'" Then
getSheetNameOfSeries = Mid(f, 1, i - 1)
Exit Do
Else
i = i + 1 ' Skip 2nd quote
End If
End If
Else
' Sheet name is quite normal, so "!" will indicate the end of sheetname
If Mid(f, i, 1) = "!" Then
getSheetNameOfSeries = Mid(f, 1, i - 1)
Exit Do
End If
End If
i = i + 1
Loop
getSheetNameOfSeries = Replace(getSheetNameOfSeries, "''", "'")
End Function
You can use the Find function to look for the values of SeriesCollection(1).
In the worksheet that hold the data of SeriesCollection(1), you will be able to find all the values in that array.
More explanations inside the code below.
Code
Option Explicit
Sub GetChartDataSheet()
Dim DataSheetName As String
Dim DataSheet As Worksheet
Dim ws As Worksheet
Dim ValuesArr As Variant, Val As Variant
Dim FindRng As Range
Dim ShtMatch As Boolean
Dim ChtObj As ChartObject
Dim Ser As Series
' if you want to use ActiveChart
Set ChtObj = ActiveChart.Parent
Set Ser = ChtObj.Chart.SeriesCollection(1)
ValuesArr = Ser.Values ' get the values of the Series Collection inside an array
' use Find to get the Sheet's origin
For Each ws In ThisWorkbook.Sheets
With ws
ShtMatch = True
For Each Val In ValuesArr ' loop through all values in array
Set FindRng = .Cells.Find(what:=Val) ' you need to find each value in the worksheet that SeriesCollection data is tied to
If FindRng Is Nothing Then
ShtMatch = False
Exit For
End If
Set FindRng = Nothing ' reset
Next Val
If ShtMatch = True Then
Set DataSheet = ws
Exit For
End If
End With
Next ws
DataSheetName = DataSheet.Name
End Sub
I'm having trouble creating Worksheet variables. I can't work out why the code below doesn't work. It is fine when I don't try to use the worksheet scheduleSheet (i.e. when I use the commented out line instead), but gives a compile error, "member or data method not found" when I try to use a worksheet variable. The problem seems to be when combining the worksheet variable with .CheckBox... as the rest of the code works (with scheduleSheet) when I comment out these lines (HT Olle Sjögren)
Sub Reset(sheetNamePrefix As String)
'reset sheet as blank
Application.EnableEvents = False
Dim scheduleSheetName As String
Dim constantsSheetName As String
Dim summarySheetName As String
Dim scheduleSheet As Worksheet
scheduleSheetName = sheetNamePrefix & "Schedule"
constantsSheetName = sheetNamePrefix & "Constants"
summarySheetName = sheetNamePrefix & "Summary"
Set scheduleSheet = ThisWorkbook.Sheets(scheduleSheetName)
'With Worksheets(scheduleSheetName)
With scheduleSheet
.CheckBox1.Value = False
.CheckBox2.Value = False
.Range("B4:G7,J4:L4").ClearContents
If LastCell(Worksheets(scheduleSheetName)).Row > 10 Then
.Range("A11:AA" + CStr(LastCell(Worksheets(scheduleSheetName)).Row)).Clear
End If
.Range("A11:A100").NumberFormat = "#" 'Clear
End With
With Worksheets(constantsSheetName)
.Range("A18:A24").Clear
.Cells(18, 1) = 2
.Cells(19, 1) = 1
.Cells(20, 1) = 180
.Cells(21, 1) = 15
.Cells(22, 1) = 360
.Cells(23, 1) = 30
.Cells(24, 1) = 40
.Cells(50, 1) = 0
End With
With Worksheets(summarySheetName)
.Range("C2:D6").ClearContents
.Range("D8:D19").ClearContents
.Range("D21:D25").ClearContents
.Range("D27:D33").ClearContents
End With
Application.EnableEvents = True
End Sub
I would check to make sure that scheduleSheetName is a valid sheet name. Put a break point after this variable is set and see if scheduleSheetName is a valid sheet name in your workbook.
Check to make sure that your checkboxes are named the same as what you have them named in the code.
If you use
.CheckBoxes("yourCheckBoxName").Checked
it should work.
I have a named range lstVendors that refers to: =OFFSET(Data!$W$2,0,0,COUNTA(Data!$W$2:$W$400),1). I want this range to be populated when the workbook opens. I have the following code for this:
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Dim rslt()
Dim i As Integer
Dim n As Integer
Dim startRng As Range
Dim DropDown1 As DropDown
ThisWorkbook.Sheets("Dashboard").Shapes("TextBox 6").Visible = False
' Range("lstVendors").Offset(0, 0).Value = "Please Select..."
' Set DropDown1 = ThisWorkbook.Sheets("Dashboard").DropDowns("Drop Down 1")
' DropDown1.Value = 1
On Error Resume Next
If Not IsError(Range("lstVendors")) Then
Range("lstVendors").ClearContents
End If
On Error GoTo 0
rslt = Application.Run("SQLite_Query", "path/to/my/sqlite", "SELECT PROGRAM_ID FROM VENDOR;")
Set startRng = Range("lstVendors")
i = 0
For n = 2 To UBound(rslt)
Range("lstVendors").Offset(i, 0).Value = rslt(n)(0)
i = i + 1
Next n
End Sub
It errors on the Set startRng = Range("lstVendors"). I know this is because there's nothing in the range when I'm trying to set it, because if I put one entry into the named range, the set works, however, I need it populated by the sqlite query on each open as the data changes.
Any suggestions much appreciated.
Try this. You have a dynamic range that doesn't evaluate after you clear the contents. To avoid this, there are probably several ways, but easy to simply hardcode the startRange variable so that it always points to Data!$W$2 address, which is (or rather, will become) the first cell in your lstVendors range.
Private Sub Workbook_Open()
Dim rslt()
Dim i As Integer
Dim n As Integer
Dim startRng As Range
Dim DropDown1 As DropDown
Dim rngList As Range
'// Define your startRange -- always will be the first cell in your named range "lstVendors"
' hardcode the address because the dynamic range may not evalaute.
Set startRange = Sheets("Data").Range("W2")
'// Empty th lstVendors range if it exists/filled
On Error Resume Next
Range("lstVendors").Clear
On Error GoTo 0
'// Run your SQL query
rslt = Application.Run("SQLite_Query", "path/to/my/sqlite", "SELECT PROGRAM_ID FROM VENDOR;")
i = 0
'// Print results to the Worksheet, beginning in the startRange cell
For n = 2 To UBound(rslt)
'Increment from the startRange cell
startRange.Offset(i, 0).Value = rslt(n)(0)
i = i + 1
'Verify that "lstVendors" is being populated
Debug.Print Range("lstVendors").Address
Next n
End Sub
Thanks for the suggestions. Here is what I ended up doing in order to get around my problem. It involves adding something I didn't specify would be ok in my original question, so David's answer is great if what I did isn't an option. I first populated the first two cells in my named range with "Please Select..." and "All". In Sub Workbook_Open() we do this:
Private Sub Workbook_Open()
Application.WindowState = xlMaximized
Dim rslt()
Dim i As Integer
Dim n As Integer
Dim startRng As Range
Dim DropDown1 As DropDown
' Disable our not found message
ThisWorkbook.Sheets("Dashboard").Shapes("TextBox 6").Visible = False
' Set our start range to our named range
Set startRng = Range("lstVendors")
' Grab all vendor names
rslt = Application.Run("SQLite_Query", "path/to/my/sqlite", "SELECT PROGRAM_ID FROM VENDOR;")
' Print result. Skip first two rows as constants "Please Select..." and "All" are populated there
i = 2
For n = 2 To UBound(rslt)
startRng.Offset(i, 0).Value = rslt(n)(0)
i = i + 1
Next n
End Sub
Then we will create Sub Workbook_BeforeClose:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
' Disable the save changes dialog. This workbook will be locked up for display only. No need to confuse the user.
Application.DisplayAlerts = False
' Clear everything below the "Please Select..." and "All" cells in the named range
On Error Resume Next
Range("lstVendors").Offset(2, 0).ClearContents
On Error GoTo 0
' Save the changes to the named range
ThisWorkbook.Save
Application.DisplayAlerts = True
End Sub
This information is going to populate a drop down, so having Please Select and All hardcoded into the named range is acceptable for me. If that stipulation doesn't work for someone else looking at this in the future, please use David's suggestion! Thanks again!