I need to name my headers according to the items I have in a combo box. I'm basically taking the items from a combo box and adding them to the end of an existing header row in a excel sheet, so starting at the first empty cell in the headers row. However, I can't seem to move to the next cell to the right which would be the next header/column name. Here is my code thus far:
For i = 0 To ComboBox1.Items.Count - 1
Dim s As String
s = Convert.ToString(ComboBox1.Items(i))
xlWorkSheet.Range(columnName & "1").Value = s
Next i
ColumnName is the next blank header in that row, Column "L", so from there i would like to populate that cell then move to the right to the next cell.
As others have suggested, you can use Cells() to help iterate easier. Note that the user/macro needs the column number, not letter:
Edit: How's this instead:
Dim s As String
Dim myCol As Long
For i = 0 To ComboBox1.Items.Count - 1
myCol = Range(columnName & 1).Column
s = Convert.ToString(ComboBox1.Items(i))
xlWorksheet.Cells(1, myCol + i).Value = s
Next i
Loops are so yesterday :]
You can set all headers at once with something like:
Dim headers = ComboBox1.Items.Cast(Of Object).ToArray
xlWorkSheet.Range("A1").Resize(1, headers.Length).Value2 = headers
Also, when you get acceptable answer you should check the green check next to it https://stackoverflow.com/tour
This is what finally worked for me
Dim headers = ComboBox1.Items.Cast(Of Object).ToArray
xlWorkSheet.Range(columnName & "1").Resize(1, headers.Length).Value2 = headers
you can create a method that will get parameter of the column number
to start, use counter to point the column index.
if headers are not in row 1 so add another parameter of row and
replace xlWorksheet.Cells(1, counter) with
xlWorksheet.Cells(yourNewParameter, counter).
use short or integer data type not Long.
you dont need to create a variable for xlWorksheet.Cells(1,
counter)
make your code shorter.
code:
Private Sub AddHeaders(ByVal columnNumberToStart As Short)
Dim counter As Short = columnNumberToStart
For i = 0 To ComboBox1.Items.Count - 1
xlWorksheet.Cells(1, counter) = ComboBox1.Items(i).ToString()
counter += 1
Next
End Sub
This also worked:
For i = 0 To ComboBox1.Items.Count - 1
Dim s As String
myCol = xlWorkSheet.Range(columnName & 1).Column
s = Convert.ToString(ComboBox1.Items(i))
xlWorkSheet.Cells(1, myCol + i).Value = s
Next i
Related
I'm working on a project and need at the moment to find the first empty cell just after text cells in a row in Excel. To clarify, let me explain to you what I'm lookng for with this screenshot
I want to write a code to return for me for like an example in the case of the 20th row the number of column of the cell E20 even if the first empty cell is A20 but like I said, i want the first empty cell juste after the last "not empty" one.
for the 21th row the result will be C21, the 22th row it will be F22 and there you go
Here's the code I wrote but for some reason it doesn't work, please help.
Function emptyCell(ws As Worksheet, ligne As Integer)
Dim m, p, n As Integer
Dim suite(700) As Integer
For k = 0 To 700
suite(k) = 0
Next
emptyCell = 0
i = 1
Do Until suite(i) = 0 And suite(i - 1) = 1
If ws.Cells(ligne, i) <> "" Then
suite(i) = 1
End If
i = i + 1
emptyCell = emptyCell + 1
Loop
End Function
Sub test()
Dim d As Integer
empty_cell = emptyCell(Sheets("tmp"), 2)
MsgBox (empty_cell)
End Sub
The logic of my code is to assign 0 for empty cells and 1 in the other caase, run a test to find the first 1-0 that's gonna appear in my array and get the column order from the order of this "1"
I know I'm not that clear cause I didnt want it to make it a long post and english is not my first language.
Thanks in advance
All if you want to get the first empty cell after the last non empty cell, why not try it like this?
Function emptyCell(ws As Worksheet, Row As Long) As Range
Set emptyCell = ws.Cells(Row, ws.Columns.Count).End(xlToLeft).Offset(, 1)
End Function
Sub Test()
Dim empty_cell As Range
Set empty_cell = emptyCell(Sheets("tmp"), 20)
MsgBox empty_cell.Address
End Sub
My macro is to send emails for some clients. It sends the email only if there is a X at one of the lines of the column B, so then it sends the whole line to the client by creating a new sheet that goes attached to the client on the email.
The problem is that I need to create a loop to count all the columns that contain the letter X, because this macro is counting only the first line that contains the letter X and then the other ones don't go to the new sheet and consequently it doesn't go to the client. Everything is OK in my macro, despite of the counter. When i run it, just the first line that contains the X goes to the client, and the others don't. Can you guys help me?
Code:
LinhaInicio = 1
While Workbooks(planilha).Sheets("Boletas").Cells(LinhaInicio, 2) <> "X"
LinhaInicio = LinhaInicio + 1
Wend
LinhaFim = LinhaInicio
While Workbooks(planilha).Sheets("Boletas").Cells(LinhaFim, 2) = "X"
LinhaFim = LinhaFim + 1
Wend
LinhaFim = LinhaFim - 1
RangeInicio = Workbooks(planilha).Sheets("Boletas").Cells(LinhaInicio, 26).Address
RangeFim = Workbooks(planilha).Sheets("Boletas").Cells(LinhaFim, 34).Address
Set RangeCopiar = ActiveSheet.Range(RangeInicio, RangeFim)
Maybe Try something like this:
Dim vArr As Variant
Dim LinhaFim As Long
Sub mainLoop()
'put all values into variant array vArr
vArr = Workbooks(planilha).Sheets("Boletas").UsedRange
For i = LBound(vArr) To UBound(vArr)
If vArr(i, 2) = "X" Then
Nestedloops (i) 'initiate nested loops
i = LinhaFim 'artificially increment counter
End If
Next i
End Sub
Sub Nestedloops(LinhaIncio As Long)
With Workbooks(planilha).Sheets("Boletas")
LinhaFim = linhaInicio
While vArr(LinhaFim, 2) = "X"
LinhaFim = LinhaFim + 1
Wend
LinhaFim = LinhaFim - 1
RangeInicio = .Cells(LinhaInicio, 26).Address
RangeFim = .Cells(LinhaFim, 34).Address
Set RangeCopiar = ActiveSheet.Range(RangeInicio, RangeFim)
'email code goes here
End With
End Sub
Tim could come up with something better though might want to see what he comes up with
you wanna search the X letter to columns or rows, sorry I didn't understand what you try to say. You want to create a loop to count all the X letter for every row and column or only for every row from a column?
here is how you define an array:
Dim timelinessSheet, o As Variant
timelinessSheet = Worksheets("your_sheet_name").Range("A2:X" & Worksheets("your_sheet_name").Cells(Worksheets("your_sheet_name").Rows.Count, "B").End(xlUp).Row).Value
and then your code
dim i as long
for i=2 to ubound (timelinessSheet,1)
if timelinessSheet(i,2)= X then
Your_condition
end if
next I
I am writing a VBA code that goes through a defined matrix size and filling cells randomly within its limits.
I got the code here from a user on stackoverflow, but after testing it I realized that it does not fit for avoiding duplicate filling, and for instance when filling 5 cells, I could only see 4 cells filled, meaning that the random filling worked on a previously filled cell.
This is the code I'm working with:
Dim lRandom As Long
Dim sCells As String
Dim sRandom As String
Dim rMolecules As Range
Dim i As Integer, j As Integer
Dim lArea As Long
lArea = 400 '20x20
'Populate string of cells that make up the container so they can be chosen at random
For i = 1 To 20
For j = 1 To 20
sCells = sCells & "|" & Cells(i, j).Address
Next j
Next i
sCells = sCells & "|"
'Color the molecules at random
For i = 1 To WorksheetFunction.Min(5, lArea)
Randomize
lRandom = Int(Rnd() * 400) + 1
sRandom = Split(sCells, "|")(lRandom)
Select Case (i = 1)
Case True: Set rMolecules = Range(sRandom)
Case Else: Set rMolecules = Union(rMolecules, Range(Split(sCells, "|")(lRandom)))
End Select
sCells = Replace(sCells, "|" & sRandom & "|", "|")
lArea = lArea - 1
Next i
rMolecules.Interior.ColorIndex = 5
Using this same exact code which works perfectly, WHAT can I insert and WHERE do I do that so that the code would check if a cell is previously already filled with a string or a color?
I feel as though this code I'm looking for should be right before
rMolecules.Interior.ColorIndex = 5
But I'm not sure what to type.
EDIT
From the comments I realized that I should be more specific.
I am trying to randomly fill cells with the blue color (.ColorIndex = 5), but what I need to check first is if the randomizing hadn't marked a cell twice, so that for instance in this case, if I want to mark 5 different cells, it marks only 4 of them because of a duplicate and thus fills only 4 cells with the blue color. I need to avoid that and make it choose another cell to mark/fill.
I'd appreciate your help.
Keep the cells you use in a Collection and remove them as you fill the random cells:
Sub FillRandomCells(targetRange As Range, numberOfCells As Long)
' populate collection of unique cells
Dim c As Range
Dim targetCells As New Collection
' make sure arguments make sense
If numberOfCells > targetRange.Cells.Count Then
Err.Raise vbObjectError, "FillRandomCells()", _
"Number of cells to be changed can not exceed number of cells in range"
End If
For Each c In targetRange.Cells
targetCells.Add c
Next
' now pick random 5
Dim i As Long, randomIndex As Long
Dim upperbound As Long
Dim lowerbound As Long
For i = 1 To numberOfCells
lowerbound = 1 ' collections start with 1
upperbound = targetCells.Count ' changes as we are removing cells we used
randomIndex = Int((upperbound - lowerbound + 1) * Rnd + lowerbound)
Set c = targetCells(randomIndex)
targetCells.Remove randomIndex ' remove so we don't use it again!
c.Interior.Color = 5 ' do what you need to do here
Next
End Sub
Sub testFillRandomCells()
FillRandomCells ActiveSheet.[a1:t20], 5
FillRandomCells ActiveSheet.[b25:f30], 3
End Sub
EDIT: Changed to make the target range and number of changed cells configurable as arguments to a function. Also added error checking (always do that!).
Why not build a list of random numbers and place in a Scripting.Dictionary, one can use the Dictionary's Exist method to detect duplicates, loop through until you have enough then you can enter your colouring code confident that you have a unique list.
This is what my cells look like:
This is my code, I'll explain it below.
Sub Macro1()
Dim product as String
Dim group as Long
Dim recordno as Long
dim pol_number as Long
dim plan_name as Long
product = "corp"
group = 1
recordno = 1
pol_number = 1
plan_name = "TTT"
Range("A2").Select
For i = 1 to 5
ActiveCell.Value = Selection.End(xlUp).Value
ActiveCell.Offset(0,1).Select
Next i
End Sub
I want to fill in all of the cells with the variable values. I understand that variables are not case sensitive, and I understand that the code I have will just fill the cell with the text in the upmost cell of the column, but I don't know if there is a function that would take the text of the top cell and convert it to a variable. Is that possible?
Try this to go from variables to cells
Dim values as Variant
'Array 0 to 4
values = Array(product,group,recordno,pol_number,plan_name)
Range("A2").Resize(1,5).Value2 = values
The reverse is
Dim values as Variant
'Array 1 to 5
values = Range("A2").Resize(1,5).Value2
product = values(1,1)
group = values(1,2)
recordno = values(1,3)
pol_number = values(1,4)
plan_name = values(1,5)
If you do something like
someCell.Value = someOtherCell.Value
and someOtherCell.Value is "product" then someCell won't be filled with what you have saved in the variable product but with "product" (I included the quotation marks to emphasize that's it's a string). That's a good thing because otherwise it would mess your code up if you accidentally put in the name of some random variable in your code.
If your requirements are like this:
You have values for PRODUCT etc that you write to write in the row below PRODUCT etc.
The headers are not always in the same order.
You might want to add new variables later on without too much fuss.
Them some kind of keyed list might be what your looking for. That means that rather than referencing the variable by a numerical index, you can reference them using names.
If the order is fixed, you might be better of just using an array where item 1 is the product name, item 2 is the group number etc, like ja72 and Sgdva suggested.
However, if you still want to reference the variables by name, you could use a collection:
Dim coll As New Collection
With coll
.Add "corp", "product"
.Add 1, "group"
.Add 1, "recordno"
'...
End With
Then instead of selecting cells and referencing ActiveCell you should reference the cells directly (using selections and ActiveCell can be avoided most of the times and slows down the macro and can even cause unnecessary errors)
For i = 1 To 5
Cells(2, i).value = coll(Cells(1, i).value)
Next i
An alternative to a collection is a dictionary which offers an easy way to check if a key exists (with a collection you have to catch the error)
Dim dict As Object
Set dict = CreateObject("Scripting.Dictionary")
With dict
.Add "product", "corp"
.Add "group", 1
.Add "recordno", 1
'...
End With
Now you can check if the entry exists first so it won't throw an error:
For i = 1 To 5
If dict.Exists(LCase(Cells(1, i).value)) Then 'note that the dictionary keys are case sensitive
Cells(2, i).value = dict(LCase(Cells(1, i).value))
Else
MsgBox "Entry for " & LCase(Cells(1, i).value) & " not found!"
End If
Next i
Note that when you use dict("somekey") and the entry "somekey" doesn't exist, it won't throw an error but add an empty entry.
Why not an array and then loop through the elements as needed?
Dim ArrayTitles() As Variant 'since strings and numbers are mixed
ReDim Preserve ArrayTitles(5)
ArrayTitles(1) = "corp"
ArrayTitles(2) = 1
ArrayTitles(3) = 1
ArrayTitles(4) = 1
ArrayTitles(5) = "TTT"
Range("A2").Select
For i = 1 To 5
MsgBox (ArrayTitles(i))
I'm thinking what you are trying to accomplish can be solved in this way
for j = 1 to 6 'Or whatever your last column happens to be
if UCase(cells(1, j)) = "PRODUCT" then
if ActiveCell.Column = j then
ActiveCell.Value = "corp"
end if
end if
next j
Something like that?
I have a dated CS degree so I understand the basics of VB but I don't write macros very often and need help solving a particular condition. (...but I understand functions and object oriented programming)
Assume the following:
- Column A contains reference ID's in alphanumeric form, sorted alphabetically.
- Column B contains strings of text, or blanks.
I'm trying to write a macro that automatically removes any extra rows for each unique reference number based on the contents of the "Notes" in column B. The problem is that if column A has multiple instances of a unique ref number, I need to identify which row contains something in column B. There is one catch: it is possible that the reference number has nothing in column B and should be retained.
To explain further, in the following screenshot I would need to:
Keep the yellow highlighted rows
Delete the remaining rows
I tried to show various configurations of how the report might show the data using the brackets on the right and marked in red. Its difficult to explain what I'm trying to do so I figured a picture would show what I need more clearly.
This task is making the report very manual and time consuming.
it's pretty simple
you just go throug the rows and check whether this row needs to be deleted, an earlier row with this id needs to be deleted or nothing should happen.
in my example i mark these rows and delete them in the end.
Sub foo()
Dim rngSelection As Range
Dim startingRow As Integer
Dim endRow As Integer
Dim idColumn As Integer
Dim noteColumn As Integer
Dim idValuableRow As New Dictionary
Dim deleteRows As New Collection
Set rngSelection = Selection
startingRow = rngSelection.Row
endRow = rngSelection.Rows.Count + startingRow - 1
idColumn = rngSelection.Column
noteColumn = idColumn + 1
For i = startingRow To endRow
currentID = Cells(i, idColumn)
If idValuableRow.Exists(currentID) Then
If Trim(idValuableRow(currentID)("note")) <> "" And Trim(Cells(i, noteColumn)) = "" Then
deleteRows.Add i
ElseIf idValuableRow(currentID)("note") = "" And Trim(Cells(i, noteColumn)) <> "" Then
deleteRows.Add idValuableRow(currentID)("row")
idValuableRow(currentID)("row") = i
idValuableRow(currentID)("note") = Cells(i, noteColumn)
End If
Else
Dim arr(2) As Variant
idValuableRow.Add currentID, New Dictionary
idValuableRow(currentID).Add "row", i
idValuableRow(currentID).Add "note", Cells(i, noteColumn)
End If
Next i
deletedRows = 0
For Each element In deleteRows
If element <> "" Then
Rows(element - deletedRows & ":" & element - deletedRows).Select
Selection.Delete Shift:=xlUp
deletedRows = deletedRows + 1
End If
Next element
End Sub
it could look something like this. the only thing you need is to add Microsoft Scripting Runtime in Tools/References