I have this code that suppose to copy column titles from a file and add those titles as checkboxess to a checklist. But when I execute the code it will copy the column titles but it does not create check boxes. Any idea why it doesn't?
If sj = True Or ji = True Then
For j = 1 To 199
If Trim(wks1.Cells(4, j).Value) = "" Then
titlesj = j - 1
Exit For
End If
jTitles(j - 1) = wks1.Cells(4, j).Value
Next
j = 1
' Add column titles from files into the listbox as checkboxes
For j = 0 To titlesj
Sheet1.ListBox1.AddItem jTitles(j)
Sheet1.ListBox3.AddItem jTitles(j)
Next
wb1.Close
End If
Try this... set the ListStyle and MultiSelect properties for both "Listbox1" and "ListBox3" to "1". Place the following before both loops.
Sheet1.ListBox1.ListStyle = 1
Sheet1.ListBox1.MultiSelect = 1
Sheet1.ListBox3.ListStyle = 1
Sheet1.ListBox3.MultiSelect = 1
Source: http://www.excelforum.com/excel-programming-vba-macros/685957-listbox-with-checkboxes.html
Related
I want to write the named area in a string (and go through column D unitl last row). But if the cell is not named I get an error on "Name = wsData.Cells(i, 4).Name.Name" and code is stopping there.
I need something like, if NamedArea is nothing/empty, then do next i.
Do you have an idea?
Thank you!!
For i = 1 To LastRow
Name = wsData.Cells(i, 4).Name.Name
If UCase(arrData(k, j)) = UCase(Name) Then
arrData(k, j) = arrNames(i, 1)
x = x + 1
k = 1
j = 1
i = 1
Exit For
End If
Next i
I am trying to add values from different sheets (Sheet 2 to 5) into my main sheet (Sheet 1). In Sheet 1 I want the cells to contain the right formula pointing to the different sheets (if possible).
Typically like this:
='Sheet2'!D5+'Sheet3'!D165
All my sheets have different products, but some sheets contain same products. So I want to search through them all and ADD them in my Main Sheet (Sheet 1).
Sub UpdateMainSheet()
' Kode for å Oppdatere Plukkeliste Alle Artikler Summert
Dim AktivtArk As String
Dim AktivtArkNavn As String
Dim K As Integer
Dim Count As Integer
'Line of code to delete old data in Main Sheet:
Worksheets("Sheet1").Range("A2:H10000").Clear
AktivtArkOverskrift = "List of Articles from Sheet 2 to 5"
'Creates Headline in Main Sheet:
eRow = Sheet1.Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets("Sheet1").Cells(eRow, 1) = AktivtArkOverskrift
Worksheets("Sheet1").Cells(eRow, 1).Font.Bold = True
'Script to check and gather data from the other sheets (Sheet 2, 3, 4 and 5):
For K = 2 To 5
'For loop to check each line in sheet "K"
For I = 2 To 1000
'If function to check if the cell I in column F is empty, if so it_jumps to next row and do the same check:
If Worksheets(K).Cells(I, 6) > 0 Then
Count = 0
'For loop to check if I already have a row in the Main Sheet with the article I'm checking:
For L = 2 To 1000
'If function to check if the articles have the same article number:
If Worksheets(K).Cells(I, 1) = Worksheets("Sheet1").Cells(L, 1) Then
'Line of code that are supposed to ADD the values that is currently in the Main Sheet, togheter with the value in Sheet K:
Worksheets("Sheet1").Cells(I, 4).Formula = Worksheets("Sheet1").Cells(I, 4) + Worksheets(K).Cells(L, 4)
End If
Next L
End If
Next I
Next K
End Sub
So what I need to fix in my code is this part (located furthest inside the For Loop):
Worksheets("Sheet1").Cells(I, 4).Formula = Worksheets("Sheet1").Cells(I, 4) + Worksheets(K).Cells(L, 4)
And make it create a formula in the wanted cell, that looks something like this:
='Sheet2'!D5+'Sheet3'!D165
It must be able to add another cell as well, since the Loop are running through several Sheets (Sheet 2 to 5) that may contain the same products.
I.e. I only want one line in my Main Sheet for each product.
I managed to find the solution in the end.
It seemed I had switched the L and I in som of the looping, which resulted in the values not to be added togheter.
The following code (I did not translate to English, but can do this if someone wants/need it) solved my issue, and gave me the values from Sheet 2 to 5 sorted by product in Sheet 1:
Sub OppdaterePlukkelisteSummert()
'Kode for å Oppdatere Plukkeliste Alle Artikler Summert
Dim AktivtArk As String
Dim AktivtArkNavn As String
Dim K As Integer
Dim Teller As Integer
Dim value1 As Integer
Dim value2 As Integer
'Sletter Plukklisten for å oppdatere og sortere på nytt:
Worksheets(1).Range("A2:H10000").Clear
'HENTING AV DATA FRA ARKET "K":
AktivtArk = "Artikler Summert fra Alle Ark"
AktivtArkOverskrift = "Artikler Summert fra Alle Ark"
'Setter inn Overskrift som Forteller kva ark utstyret kommer fra:
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
Worksheets(1).Cells(eRow, 1) = AktivtArkOverskrift
Worksheets(1).Cells(eRow, 1).Font.Bold = True
'Sjekker hvilke/hvilket rader/utstyr som skal plukkes, og legger det inn i "Ark1":
For K = 2 To 5
For I = 2 To 1000
If Worksheets(K).Cells(I, 6) > 0 Then
Teller = 0
For L = 2 To 1000
If Worksheets(K).Cells(I, 1) = Worksheets(1).Cells(L, 1) Then
value1 = Worksheets(1).Cells(L, 4)
value2 = Worksheets(K).Cells(I, 4)
Worksheets(1).Cells(L, 4) = value1 + value2
Worksheets(1).Cells(L, 6) = value1 + value2
Else
Teller = Teller + 1
End If
Next L
If Teller > 998 Then
eRow = Sheets(1).Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row
For J = 1 To 11
Worksheets(1).Cells(eRow, J) = Worksheets(K).Cells(I, J)
Next J
Worksheets(1).Cells(eRow, 6).Font.Color = RGB(0, 150, 0)
Worksheets(1).Cells(eRow, 7).Font.Color = RGB(0, 150, 0)
End If
End If
Next I
Next K
Worksheets(1).Range("A2").Select
End Sub
I hope this can be useful for someone else :-)
All help and suggestion in the comments are appreciated!
I was going to illustrate with this simple example:
I = 1 'for example
For K = 2 To 5
Worksheets("Sheet1").Cells(I, 4).Value = Worksheets("Sheet1").Cells(I, 4).Value + _
WorksheetFunction.SumIf(Worksheets(K).Range("A:A"), "Bananas", Worksheets(K).Range("D:D"))
Next K
I have more than 20 hidden columns with data. I want 4 columns to appear and then the next 4 columns on each click of a button.
I tried the below code. Instead of 4 columns at a time, it shows all 20 columns in a click.
Sub compare() '
'compare macro
'selects the button1 rows for the output tab
application.screenupdating=true
range("I10:AR62").entirecolumn/hidden=false
range("B1").select
application.screenupdating=false
End
you want something like:
range(columns(j),columns(j+k)).entirecolumn.hidden=true
range(columns(y),columns(y+z)).entirecolumn.hidden=false
but you need logic to determine what j is... first scenario is where nothing is hidden:
if not columns(9).entirecolumn.hidden and not columns(13).entirecolumn.hidden and not columns(17).entirecolumn.hidden and not columns(21).entirecolumn.hidden then
Then you will want to hide such that:
j = 13
k = 15
Where that scenario is not true (ELSE), you should have some logic embedded to determine what is hidden and unhide other sections:
if not columns(9).entirecolumn.hidden then
j = 9
k = 3
y = 13
z = 3
You would need the above for each of your column groupings to tell what isn't hidden, so you know what grouping is next.
You would have listed what sections will be visible and which sections would be hidden based on the column numbers.
I know it has been a few days since anyone has posted on this, but I figured I would post this part of a macro that I have built for another project. This should work as intended, and the variables are already setup according to the OP's question.
Sub DynHideColumns()
FirstColumn = 9 ' First Column that could be hidden
LastColumn = 200 ' Last Column that could be hidden
ColumnSteps = 4 ' Number of columns to hide per start
x = FirstColumn
Z = 1
ReDim y(1 To ColumnSteps)
Do Until x > LastColumn
If ActiveSheet.Range(Columns(x), Columns(x)).EntireColumn.Hidden = False Then
If Z <= ColumnSteps Then
y(Z) = x
Z = Z + 1
Else
y(1) = ""
End If
End If
x = x + 1
Loop
ActiveSheet.Range(Columns(FirstColumn), Columns(LastColumn)).EntireColumn.Hidden = True
If y(1) = "" Then
ActiveSheet.Range(Columns(FirstColumn), Columns(FirstColumn + ColumnSteps - 1)).EntireColumn.Hidden = False
Else
If y(ColumnSteps) = LastColumn Then
ActiveSheet.Range(Columns(FirstColumn), Columns(FirstColumn + ColumnSteps)).EntireColumn.Hidden = False
Else
ActiveSheet.Range(Columns(y(1) + ColumnSteps), Columns(y(ColumnSteps) + ColumnSteps)).EntireColumn.Hidden = False
End If
End If
End Sub
I need to remove items from a Listbox using data from Range under certain conditions. I don't want to delete data in the Worksheet the Listbox is based on.
Here is an excerpt of my code:
Me.LstWSource.RowSource = ""
If Len(rRange.Offset(1, 0).Formula) > 0 Then
Set rRange = ThisWorkbook.Sheets(G_sNameReferenceS).Range(rRange.Offset(1, 0), rRange.End(xlDown))
With Me.LstWSource
.ColumnWidths = "28pt"
.RowSource = rRange.Address
.ListIndex = -1
End With '>>>
End If
'>>>>>>>>>>>>>>>>>>>>>>>>
sRet = fG_SortingBasicS("lstYear", "DESC")
'>>>>>>>>>>>>>>>>>>>>>>>>
For i = Me.LstWSource.ListCount - 1 To 0 Step -1
'>> current string condition to delete Item <<
If Me.LstWSource.List(i) > CStr(Year(G_datJourTraitee)) Then
Me.LstWSource.RemoveItem (i)
End If
Next i
The error is triggered by the RemoveItem.
If you use .RowSource to fill your ListBox you cannot remove list items from the list.
Therefore you need to fill your list using LstWSource.AddItem. Loop through your range and add each item to your ListBox based on your criteria. Also see Adding items in a Listbox with multiple columns.
For additional information and bring my definite solution related to slowing populating : I used once the read of Range cells to populate a dynamic array. Then, I use this array to exclude or include lines in another second array.
These are lines to be considered :
J = 1
For i = LBound(G_varListYears) To UBound(G_varListYears)
If G_varListYears(i) <= CStr(Year(G_datJourTraitee)) Then
'>>>
ReDim Preserve vListTMP(J)
vListTMP(J) = G_varListYears(i)
J = J + 1
'>>
ElseIf (Me.chkNextYear = True) And ((Month(G_datJourTraitee) = 11 Or Month(G_datJourTraitee) = 12) And (G_varListYears(i) = CStr(Year(G_datJourTraitee) + 1))) Then
'>>>
ReDim Preserve vListTMP(J)
vListTMP(J) = G_varListYears(i)
J = J + 1
'>>
Else
'>>
End If
Next i
With Me.LstWSource
.ColumnWidths = "28pt"
.List = vListTMP()
.ListIndex = -1
End With '>>>
Hope it'll help too.
I have an excel spreadsheet. In a column of the spreadsheet I have a list of codes (numbers).These codes (numbers) are sorted from highest to lowest values.(some of these codes has been repeated. For example I have three consecutive line with code 1001200).I want to insert new rows between each codes (in case of having repeated codes i just need one new row (for example i Just need one new row for 1001200 not 3 rows) .
I have written the following code but it does not work.
Sub addspace()
Dim space_1(5000), Space_2(5000)
For n = 1 To 5000
Debug.Print space_1(n) = Worksheets("sheet3").Cells(1 + n, 1).Value
Debug.Print Space_2(n) = Worksheets("sheet3").Cells(2 + n, 1).Value
Next
For n = 1 To 5000
If space_1(n) <> Space_2(n) Then
Range("space_1(n)").EntireRow.Insert
End If
Next
End Sub
How can I fix it? (From the code you can see that I am so beginner :)))
Cheers
To insert one empty row between each unique value try this:
Option Explicit
Public Sub addspace()
Dim i As Long
Application.ScreenUpdating = False
With Worksheets("sheet3")
For i = 5000 To 2 Step -1
While .Range("A" & i - 1) = .Range("A" & i)
i = i - 1
Wend
.Rows(i).Insert Shift:=xlDown
Next
End With
Application.ScreenUpdating = True
End Sub
It starts from the end row and moves up, skipping duplicates
The Range("space_1(n)") is invalid. Arg of range object should be a column name like "A1", you can use Range("A" & n).EntireRow.Insert in your code. But I recommend my code.
Please try,
Sub addspace()
Dim n As Integer
For n = 1 To 5000
If Worksheets("sheet3").Cells(n, 1).Value <> Worksheets("sheet3").Cells(n + 1, 1).Value Then
Worksheets("sheet3").Cells(n + 1, 1).EntireRow.Insert
n = n + 1
End If
Next
End Sub