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
Related
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
I am trying to input multiple rows in a textbox and display each value in a different row of a single column in excel, My code inputs all values in different rows of the column. Code is as follows
Private Sub CommandButton1_Click()
Dim i As Variant
For Each i In Split(TextBox1.Text, vbCrLf)
With Range("A1")
lastrow = ThisWorkbook.Worksheets("sheet1").Range("A" & Rows.Count).End(xlUp).Row + 1
ThisWorkbook.Worksheets("sheet1").Range("A" & lastrow).Value = TextBox1.Value
End With
Next
TextBox1.Text = ""
End Sub
Any suggestions please? your response will be highly appreciated
if I understand it correctly you want to have each line in the text box in its own row so this would work
Private Sub CommandButton1_Click()
Dim i As Variant
Dim rowCounter As Long
rowCounter = 1
For Each i In Split(TextBox1.Text, vbCrLf)
'start at row 1 column A
Cells(rowCounter, 1).Value = i
rowCounter = rowCounter + 1
Next
TextBox1.Text = ""
End Sub
There is no need to iterate. Split returns an array that you can use to fill all the rows at once.
Private Sub CommandButton1_Click()
Dim Target As Range
Dim Data As Variant
If TextBox1.Text = "" Then Exit Sub
Data = Split(TextBox1.Text, vbCrLf)
With Worksheets("sheet1")
Set Target = .Range("A" & .Rows.Count).End(xlUp)
If Target.Value <> "" Then Set Target = Target.Offset(1)
Target.Resize(UBound(Data) + 1).Value = Application.Transpose(Data)
End With
TextBox1.Text = ""
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 am using around 8-10 comboboxes(form control),each one having the same list of items populated. Based on the user's selection from the dropdown, a certain value is displayed in a different cell. I wanted to know if there is way to do this without using a loop(for dropdowns) as all have the same function. Here is the code I am using:
Dim ws As Sheets
Set ws = ThisWorkbook.Sheets(Array("S1 Fuel Consumption", "EF_Stat", "Summary"))
Dim i As Integer
For i = 1 To 8
With ws(1).Shapes("Fuel " & i).ControlFormat ~~> 'This is the loop I'm talking about(for 8 shapes)
Select Case .ListIndex
Case 1
ws(3).Range("B" & i).Value = Empty
Case 2
ws(3).Range("B" & i).Value = ws(2).Range("B4").Value
Case 3
ws(3).Range("B" & i).Value = ws(2).Range("C4").Value
Case 4
ws(3).Range("B" & i).Value = ws(2).Range("D4").Value
End Select
End With
Next i
Assign the same macro to all of the comboboxes and use:
With WS(1).Dropdowns(Application.Caller)
to get a reference to the combobox that triggered the macro.
If you need to figure out the 'i' value you were using in the loop originally, you can do something like this:
Dim ws As Sheets
Dim sCaller As String
Dim i As Integer
Dim rgOutput As Range
Set ws = ThisWorkbook.Sheets(Array("S1 Fuel Consumption", "EF_Stat", "Summary"))
sCaller = Application.Caller
Set rgOutput = ws(3).Range("B" & Replace(sCaller, "Fuel ", ""))
Select Case ws(1).DropDowns(sCaller).ListIndex
Case 1
rgOutput.Value = vbNullString
Case 2
rgOutput.Value = ws(2).Range("B4").Value
Case 3
rgOutput.Value = ws(2).Range("C4").Value
Case 4
rgOutput.Value = ws(2).Range("D4").Value
End Select
What is wrong with this code? It is supposed to return header (1st row) of a column in which it finds "1". I pass the row number (nr) and it is supposed to look between columns M and T (inclusive)
Function who(ByVal rowNr As Integer) As String
Dim temp As String
Dim ws As Worksheet
With ActiveSheet
Set ws = ActiveWorkbook.Sheets(.Name)
End With
For i = 13 To 20 Step 1
If ws.Cells(i, rowNr).Value = 1 Then
temp = temp & " " & ws.Cells(i,1).Value
End If
Next i
who = temp
End Function
The error I get is
Application-Defined or Object-Defined
error
And marks line
If ws.Cells(i, nr).Value = 1 Then
I truly dislike VB.
If nr is used as a numerical value, why are you sending it in as a String. Try changing that to an Integer and you should be a bit further along at least.
Edit: I forgot that I think you might have mixed up rows/columns as well. I think maybe you want it to be:
If ws.Cells(nr, i).Value = 1 Then
This worked for me
Function who(ByVal rowNr As Long) As String
Dim temp As String
Dim ws As Worksheet
Dim i As Long
Set ws = ActiveSheet
For i = 13 To 20 Step 1
If ws.Cells(rowNr, i).Value = 1 Then
temp = temp & " " & ws.Cells(1, i).Value
End If
Next i
who = Trim(temp)
End Function