I'am on VBA trying to create a macro that record in different cell the number of times the workbook is open. Each time it is open, it creates a new cell with the number of the opening. So I created a counter for that.
Option Explicit
Dim i As Integer
Private Sub Workbook_Open()
If i = "" Then
i = 1
End If
ThisWorkbook.Worksheets("Feuil1").Cells(i, 1).Value = "Session " & i
i = i + 1
Debug.Print i
End Sub
However, the statement If i = "" remains highlighted in yellow, and I don't understand why...
Would someone have a solution?
Thank you !
i is an Integer so comparison to an empty String is not valid.
The closest thing you can do is
If i = 0 Then
But if you want the value to i to persist when you save the workbook, the simplest thing to do is to read its value from the workbook.
Of course you cannot assign a string to an integer. This is a type mismatch error.
What you need is to fetch the last cell in the column and then increment it.
Private Sub Workbook_Open()
' Fetch the last cell from column 1
Dim r As Range
With ThisWorkbook.Worksheets("Feuil1")
Set r = .Cells(.Rows.Count, 1).End(xlUp)
End With
' Get the last session number, or 0 if not present or doesn't match
Dim lastSession As Long: lastSession = 0
If Not IsEmpty(r) Then
Dim p As Long: p = InStr(1, Trim(r.value), "Session ")
If p = 1 Then
lastSession = CLng(Mid(r.value, p + Len("Session "), 10000))
End If
End If
r.Offset(1).value = "Session " & (lastSession + 1)
End Sub
I'd go like follows
Private Sub Workbook_Open()
With Worksheets("Feuil1")
With .Cells(.Rows.Count, 1).End(xlUp)
.Offset(1) = "Session " & Val(Replace(.Value, "Session ", "")) + 1
End With
End With
End Sub
Related
I have this code but its hard coded. I need it to be automated in a loop or something else instead of a case statement till the empty column stops but more column will be added in a form. So the range can go from B2 to the late column in the excel sheet only if the column header is there and then it stops. It will shows the content in each column. Please note the excel sheet is called Area
Can this be done?
Private Sub ComboBox3_Change()
Dim i As Long
i = ComboBox3.ListIndex
ComboBox4.Clear
Select Case i
Case Is = 0
With Worksheets("Area")
ComboBox4.List = .Range("**B2:B**" & .Range("**b**" & Rows.Count).End(xlUp).Row).Value
End With
Case Is = 1
With Worksheets("Area")
ComboBox4.List = .Range("**C2:C**" & .Range("**c**" & Rows.Count).End(xlUp).Row).Value
End With
Case Is = 2
With Worksheets("Area")
ComboBox4.List = .Range("**D2:D**" & .Range("**d**" & Rows.Count).End(xlUp).Row).Value
End With
Case Is = 3
With Worksheets("Area")
ComboBox4.List = .Range("**E2:E**" & .Range("**e**" & Rows.Count).End(xlUp).Row).Value
End With
Case Is = 4
With Worksheets("Area")
ComboBox4.List = .Range("**F2:F**" & .Range("**f**" & Rows.Count).End(xlUp).Row).Value
End With
End Select
End Sub
Something like this should work for you:
Private Sub ComboBox3_Change()
Dim ws As Worksheet
Dim ColNum As Long
Set ws = ActiveWorkbook.Sheets("Area")
ColNum = Me.ComboBox3.ListIndex + 2
Me.ComboBox4.Clear
If ColNum < 2 Then Exit Sub 'Nothing selected
Me.ComboBox4.List = ws.Range(ws.Cells(2, ColNum), ws.Cells(ws.Rows.Count, ColNum).End(xlUp)).Value
End Sub
If you want to enumerate the column number into column name use Chr(65) where 65 is the ASCII value for A.
In your case add 66 to your integer i like Chr(66+i) which returns B
Also, there is a function to convert column number into column name in excel, =SUBSTITUTE(ADDRESS(1,col_number,4),"1","") although I haven't tried it in VBA.
In your specific case, you don't need a case statement at all
Private Sub ComboBox3_Change()
Dim i As Long
i = ComboBox3.ListIndex
ComboBox4.Clear
With Worksheets("Area")
ComboBox4.List = .Range("**E2:E**" & .Range("**e**" & Rows.Count).End(xlUp).Row).Offset(0,i).Value
End Sub
might need some tweaking since I can't test it out. But offset by 0 rows and i columns is the best solution for you
I'm creating a workbook, which tracks available rentals per month. It is divided into 12 sheets, one for each month. The first three columns of each sheet track the type of accommodation, number of bedrooms and what's included in the rental price. The concept there is that there will be a drop-down combo box that allows the user to fill in with a point-and-click option rather than typing things out in order to reduce input errors.
I set up a fixed array, the contents in which changes depending on what column that active cell is in, and then the array is assigned to the combo box. The code lives in the Sheet1 Module under the combo box code and the ThisWorkbook module calls it under SheetSelectionChange, so as to avoid repeating the code in each sheet.
A Standard Module makes the array public
All 12 combo boxes share the same name, cboOptions, and they populate correctly, regardless of what sheet is chosen. My problem is that none of the combo boxes return the listindex value of the choice that's made, regardless of the code telling it to do so. I've been testing to see the value of the position returned against the value of the position chosen, but I have not been able to establish a pattern. I thought about clearing the variables and arrays, thinking that might be what's messing with the code, but it seems to be having no effect. I've read what I could on the issue, but I'm out of ideas on what might be the problem...thank you in advance!
Code in Sheet1 module:
Private Sub cboOptions_Change()
Erase myarray()
cboOptions.Visible = True
cboOptions.Enabled = True
cboOptions.Clear
n = ActiveCell.Row
If n >= 3 And n < 10000 Then
If ActiveSheet.Range(ActiveCell.Address).Address = Range("A" & n).Address Then
myarray(1) = "Apartment"
myarray(2) = "Room"
myarray(3) = "Townhouse"
myarray(4) = "House"
ElseIf ActiveSheet.Range(ActiveCell.Address).Address = Range("B" & n).Address Then
myarray(1) = "1"
myarray(2) = "2"
myarray(3) = "3"
myarray(4) = "4"
myarray(5) = "5"
ElseIf ActiveSheet.Range(ActiveCell.Address).Address = Range("C" & n).Address Then
myarray(1) = "Heat & Water"
myarray(2) = "All-inclusive"
Else
cboOptions.Enabled = False
cboOptions.Visible = False
End If
End If
'ActiveSheet.cboOptions.ListIndex = 0
'Dim x As Long
'MsgBox ActiveSheet.Name
With ActiveSheet
.cboOptions.Left = .Range(ActiveCell.Address).Left
.cboOptions.Top = .Range(ActiveCell.Address).Top
.cboOptions.List = myarray()
With .cboOptions
'the problem is that x needs to get assigned a value from the combo box before it continues to execute
x = .List(.ListIndex)
'MsgBox x
End With
.Range(ActiveCell.Address) = x 'myarray(x)
.Columns(ActiveCell.Column).ColumnWidth = cboOptions.Width * 0.18
x = 0
Erase myarray()
End With
End Sub
Code in ThisWorkbook:
Sub Workbook_SheetSelectionChange(ByVal sh As Object, ByVal Target As Range)
Application.Run "Sheet1.cboOptions_Change"
End Sub
Code in Module1:
Option Explicit
Public myarray(0 To 5) As String
The nature of the problem seems to be that using more than one array for one combo box breaks down how the listindex values are calculated. I broke down the code to its component features to see if the issue persisted
1) Made a new file and put the code in Sheet1
2) Made separate fixed arrays for each kind of input
3) Created a separate routine for each kind of input
Using ON ERROR RESUME NEXT at the beginning of each routine overlooks the error and the code works properly. Alternatively, putting in a break where the integer variable is given the listindex value of the combo box allows the user to make a choice and assign a value to the integer variable, before continuing. Otherwise, its default value is -1 and returns an error; using .list(.listindex) did not make any difference, suggesting that the code needs to wait for user input (using a combobox event other than Change?).
May just need to establish a separate combo box for each column. Anyway, the code below is the sticks-and-stones version of the above, for a single sheet, and it will do the job if applied to each sheet module in the workbook:
Sub monthnames()
'add month names to the first cell of each sheet
Dim n As Integer
'Sheets(1).Activate
For n = 1 To 12
Sheets.Add After:=ActiveSheet
ThisWorkbook.Sheets(n).Cells(1, 1) = MonthName(n)
Next
End Sub
Private Sub cboOptions_Change()
Dim myarray(1 To 4) As String
Dim myarray2(1 To 5) As String
Dim myarray3(1 To 2) As String
cboOptions.Enabled = True
cboOptions.Visible = True
Dim n As Integer
n = ActiveCell.Row
If n >= 3 And n < 10000 Then
If Range(ActiveCell.Address).Address = Range("A" & n).Address Then
myarray(1) = "Apartment"
myarray(2) = "Room"
myarray(3) = "Townhouse"
myarray(4) = "House"
cboOptions.List = myarray()
inputdata myarray(), n
ElseIf Range(ActiveCell.Address).Address = Range("B" & n).Address Then
myarray2(1) = "1"
myarray2(2) = "2"
myarray2(3) = "3"
myarray2(4) = "4"
myarray2(5) = "5"
cboOptions.List = myarray2()
inputdata2 myarray2(), n
ElseIf Range(ActiveCell.Address).Address = Range("C" & n).Address Then
myarray3(1) = "Heat & Water"
myarray3(2) = "All-inclusive"
cboOptions.List = myarray3()
inputdata3 myarray3(), n
Else
cboOptions.Enabled = False
cboOptions.Visible = False
End If
End If
End Sub
Sub inputdata(myarray, n) 'myarray3, )
On Error Resume Next
Dim x As Integer
cboOptions.Left = Range(ActiveCell.Address).Left
cboOptions.Top = Range(ActiveCell.Address).Top
Columns(ActiveCell.Column).ColumnWidth = cboOptions.Width * 0.18
If Range(ActiveCell.Address).Address = Range("A" & n).Address Then
x = cboOptions.ListIndex + 1
Range(ActiveCell.Address) = myarray(x)
Else
Exit Sub
End If
End Sub
Sub inputdata2(myarray2, n)
On Error Resume Next
Dim y As Integer
cboOptions.Left = Range(ActiveCell.Address).Left
cboOptions.Top = Range(ActiveCell.Address).Top
Columns(ActiveCell.Column).ColumnWidth = cboOptions.Width * 0.18
If Range(ActiveCell.Address).Address = Range("B" & n).Address Then
y = cboOptions.ListIndex + 1
Range(ActiveCell.Address) = myarray2(y)
Else
Exit Sub
End If
End Sub
Sub inputdata3(myarray3, n)
On Error Resume Next
Dim z As Integer
cboOptions.Left = Range(ActiveCell.Address).Left
cboOptions.Top = Range(ActiveCell.Address).Top
Columns(ActiveCell.Column).ColumnWidth = cboOptions.Width * 0.18
If Range(ActiveCell.Address).Address = Range("C" & n).Address Then
z = cboOptions.ListIndex + 1
Range(ActiveCell.Address) = myarray3(z)
Else
Exit Sub
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call cboOptions_Change
End Sub
I have been trying to write a program that will loop through all the cells in an excel sheet and if one starts with a '#' it should display a message. here's the code:
(template is a worksheet variable)
Private Function processTemplate()
Dim total As Long
total = template.UsedRange.count
Dim count As Integer
count = 0
While count <= total
If template.Cells(count).Value Like "[#]*" Then 'Here I get a error
MsgBox "Found #"
End If
count = count + 1
Wend
End Function
I have isolated the error to using a variable inside of cells(). If I replace count with some number (like 8) it works fine. I am getting error 1004 on the line If template.Cells(count).Value Like "[#]*" Then
If I make total an Integer it has the same error at the same place. After about 2-3 hrs of research/banging my head on the wall I have no idea. I initially got the error when assigning template.cells(row, col).Value to a string variable.
Here's my code now:
Private Sub processTemplate()
MsgBox Len("")
Dim str As String
Dim rows As Long
Dim cols As Long
rows = template.UsedRange.Height
cols = template.UsedRange.Width
Dim row As Integer
row = 1
While row < rows
Dim col As Integer
col = 1
While col < cols
str = template.Cells(row, col).Text
If Len(str) > 0 Then
If Left(template.Cells(row, col).Text, 1) = "#" Then
MsgBox "Found IT"
End If
End If
Rem MsgBox template.Parent.Name & ": " & template.Name & ", Cell(" & row & ", " & col & "): " & template.Cells(row, col).Value
col = col + 1
Wend
row = row + 1
Wend
End Sub
Now I get the error on str = template.Cells(row, col).Text
We can use a sub rather than a function
We loop over all the cells in UsedRange looking for a # as the first character in the cell.
Sub FindThePound()
Dim r As Range, pound As String, template As Worksheet
pound = "#"
Set template = ActiveSheet
For Each r In template.UsedRange
If Left(r.Value, 1) = pound Then
MsgBox "Found # in " & r.Address(0, 0)
End If
Next r
End Sub
EDIT#1
This version loops over all the cells, but does not test cells containing formulas
Sub FindThePound()
Dim r As Range, pound As String, template As Worksheet
pound = "#"
Set template = ActiveSheet
For Each r In template.UsedRange
If r.HasFormula = False Then
If Left(r.Value, 1) = pound Then
MsgBox "Found # in " & r.Address(0, 0)
End If
End If
Next r
End Sub
You could use find/ find next function which i guess bit faster than looping through each cell and do string comparison.
With Worksheets(1).Range("a1:a500") 'Provide the search range
Set c = .Find(2, lookin:=xlValues) ' searching for 2 in cell value
If Not c Is Nothing Then
firstAddress = c.Address 'first occurance
Do
'do whatever you want to do with the matches even replace them
c.Value = 5
Set c = .FindNext(c)
Loop While Not c Is Nothing And c.Address <> firstAddress
End If
End With
Reference:
http://msdn.microsoft.com/en-us/library/office/ff196143(v=office.15).aspx
I have a sheet that has a table on it, the following function will be used to search another sheet and return the number of times the agents name shows up;
The problem I'm having is that if I try to copy and paste the value it will change from a number to '#Value!'. Also, when switching worksheets and then switching back to the worksheet that has the UDF being called it changes all values to '#Value!'
Here is the function and how it is called. Any help would be greatly appreciated.
Public Function GetMatrixCount(AgentName As String) As Integer
Dim matrixSheet As Worksheet, mContainer() As String, c As Integer, m As Integer, y As Integer
Dim fullRange As Range, l As Range, lastRow As Integer
Dim firstThree As String, curAgent As String
'toDo
'return zero if the matrix updates worksheet doesn't exist or the input string is empty
On Error Resume Next
Set matrixSheet = Sheets("Matrix Updates")
On Error GoTo 0
If matrixSheet Is Nothing Or Not Trim(AgentName) <> "" Then
GetMatrixCount = 0
Exit Function
End If
'get month number user wants to input from the title at the top of the page - used to do value check on matrix updates data
mContainer() = Split(Range("B1").Value, " ")
m = month(DateValue(mContainer(UBound(mContainer) - 1) & " 1"))
y = mContainer(UBound(mContainer))
firstThree = Left(AgentName, 3)
lastRow = matrixSheet.Cells(Rows.Count, 1).End(xlUp).Row
c = 0
Set fullRange = matrixSheet.Range("B2:B" & lastRow)
For Each l In fullRange.Cells
curAgent = l.Offset(0, 1).Value
If month(l.Value) = m And year(l.Value) = y And Left(curAgent, 3) = firstThree And Mid(curAgent, InStrRev(curAgent, " ") + 1) = Mid(AgentName, InStrRev(AgentName, " ") + 1) Then
c = c + 1
End If
If l.Value = "" Then
Exit For
End If
Next
GetMatrixCount = c
End Function
Usage:
=GetMatrixCount(B4)
B4: John Doe
UPD:
Try to write following:
Set wb = ThisWorkbook
Set matrixSheet = wb.Sheets("Matrix Updates")
It should fix the problem when you switch workbooks.
I have a piece of code that takes the value in a cell and sets a different cell based on the value. It is a simple code, I just can not figure out how to loop it to go through the whole column. Can some one guide me to how this can be done? Thanks in advance!
Here is the code I have:
Dim pH As Single, Program As String
pH = Range("D2").Value
If pH <= 7.8 Then
Program = "Neutral"
Else
Program = "Alkaline"
Range("E2").Value = Program
You don't need VBA yet
set formula in your E2 '= IIF(D2<=7.8;"Neutral";"Alkaline")'
And you can copy it to below E columns
If you want to do this in VBA, you can create a 'Do Until' Loop to go until there are no more values in the column:
Sub Looper()
Dim i as Integer
Dim Sel as String
Dim MoveDown as String
Dim pH as Single
Dim Program as String
i = 2
MoveDown = "YES"
Do Until MoveDown = "DONE"
Sel = "D" + Replace(Str(i), " ", "")
ph = Range(Sel).Value
If pH <= 7.8 Then
Program = "Neutral"
Else
Program = "Alkaline"
End If
Sel = "E" + Replace(Str(i), " ", "")
Range(Sel).Value = Program
i = i + 1
Sel = "D" + Replace(Str(i), " ", "")
If Range(Sel).Value = "" Then
MoveDown = "DONE"
End If
Loop
End Sub
this might be the optimum solution using VBA :
Sub mysub()
Set Wksht = ThisWorkbook.Sheets("Sheet1") 'the Worksheet name you want to fetch data from
Wksht.Select
Set myRange = Wksht.Range("D2", Range("D65536").End(xlUp))
For Each myCell In myRange.Cells
If myCell > 7.8 Then
myCell(1, 2) = "Natural"
Else
myCell(1, 2) = "Alkaline"
End If
Next myCell
End Sub
Blockquote : myCell(1,2) is refering to the current row and E column ..it will use relative address from the current cell address....so if Current cell address is D2 ..myCell(1,2) is eqvivalent to E2 like wise myCell(1,3) means F2, [ myCell(row , column ) ].