Comboxes items compare and match -VBA - excel

I have 2 excel sheets : one containing the source data and one contains the goal data. i have created userform that contains comboboxes(dropdownlists)and import button .
there are comboboxes that contain the names of the first row of the Source sheet and other comboboxes that contain the names of the first row of the goal sheet.
i want to compare the names in the comboboxes ( source and goal names) and match them if they are equal
than when i click on import Button , everything in the source excel sheet will be imported in the goal excel sheet in the right place.
how can i do that ?
I TRIED THIS CODE
dim sh =ThisWorkbook.Sheets("sourcedata")
dim sh2= ThisWorkbook.Sheets("goaldata")
dim i,j as integer
for i = 1 to Application.WorksheetFunction.CountA(sh.Range("1:1"))
for j = 1 to Application.WorksheetFunction.CountA(sh2.Range("1:1"))
if sh.cells(1,i).value = sh2.cells(1,j).value then
Me.comboBox1.value = sh.cells(1,i)
Me.comboBox2.value = sh2.cells(1,j)
Me.comboBox3.value = sh.cells(1,i)
Me.comboBox4.value = sh.cells(1,j)
end if
next
next
end sub
the problem that i get usually the same value in all comboboxes.
i want to get in all comboboxes the names of the rows in both sheets.
for example i have the rows names of the Source sheet : Date , Event and place
the rows names in the goal sheet are : Date and Event only
for example : in combobox1.value= Date should also in comboBox2.value = Date (because Date exists in both sheets)
combBox3.value = Event and Combobox 4.value should be Event
I want to insert Combobox5.value = place ( combobox 5 contain the names that exist only in one sheet and they don't have any match )
Any help?

I think I understood the 3 combobox part but not completely the "which data should be copied" part so let's already advance on the combobox part.
Some notes about your code:
When you don't mention a dataType in you dim the vars are by default in variant type => e.g. dim i => is the same as dim i as variant. although not always a problem it could lead to unexpected behaviour;
The "combobox.value" is to get the selected value of the combobox, not to add items to it. Looking at your desc. and code I think you intented to add items.
So hereunder a revised version based on my assumptions. instead of using the "add ..Item" I just assigned the sheet cells to arrays as we can then manipulate these directly in memory, allowing operations like comparing, copying, etc.. to be performed much faster.
Option Explicit
Sub UserForm_Initialize()
Dim arr, arr2
arr = Sheet1.Range("A1:c1").Value2
Me.ComboBox1.List = Application.WorksheetFunction.Transpose(arr)
arr2 = Sheet2.Range("A1:c1").Value2
Me.ComboBox2.List = Application.WorksheetFunction.Transpose(arr2)
Dim i As Long, arr3, ii As Long: ii = 1
ReDim arr3(1 To 1, 1 To UBound(arr, 2))
For i = 1 To UBound(arr, 2)
If arr(1, i) <> arr2(1, i) Then
arr3(1, ii) = arr(1, i)
ii = ii + 1
End If
Next i
Me.ComboBox3.List = Application.WorksheetFunction.Transpose(arr3)
End Sub
Have a look at it and let me know how it went.

Related

Map unique values to a specific Excel sheet

I'm wondering if its possible to create a VBA that map a random "numerical codes" from an excel Spreadsheet 2 (let's say column A) to a column B (Spreadsheet 1).
Some of the values on the spreadsheet 2 are repeated, I would like to build a unique correspondence (no repeated values from column A / Spreadsheet 2 to my column B / Spreadsheet 1)
Spreadsheet1:
Spreadsheet2
Desired output, column filled from Spreadsheet2 (Unique)values :
Is this possible?? feasible??
The following VBA code uses for loops to iterate through the list of values in Spreadsheet2 and only copy each value to Spreadsheet1 if the value has not occurred already in the list.
Option Explicit
Sub ListUniqueCodes()
Dim code As Long
Dim codes As Range
Dim i As Integer
Dim j As Integer
Dim last_row As Integer
Dim output_cell As Range
Dim unique_codes As New Collection 'You could also use a Scripting.Dictionary here as suggested by JvdV
'See https://stackoverflow.com/questions/18799590/avoid-duplicate-values-in-collection
'Store the length of the list of codes that is in Spreadsheet2:
last_row = Workbooks("Spreadsheet2.xlsx").Sheets("Sheet1").Range("A1").End(xlDown).Row
'Store the list of codes that is in Spreadsheet2:
Set codes = Workbooks("Spreadsheet2.xlsx").Sheets("Sheet1").Range("A1:A" & last_row)
'For each code...
For i = 1 To codes.Rows.Count
code = codes.Cells(i).Value2
'...if it does not equal zero...
If code <> 0 Then
'...and if it is not already in the collection unique_codes...
For j = 1 To unique_codes.Count
If unique_codes(j) = code Then Exit For
Next j
'...then add it to the collection unique_codes:
If j = (unique_codes.Count + 1) Then
unique_codes.Add code
End If
End If
Next i
Set output_cell = Workbooks("Spreadsheet1.xlsm").Sheets("Sheet1").Range("B2")
'Write out the unique codes in Spreadsheet1:
For i = 1 To unique_codes.Count
output_cell.Offset(i - 1, 0).Value2 = unique_codes(i)
Next i
End Sub

how can i use get the columns data when looking through them?

I have multiple sheets, each with 1 only 1 table at various widths and heights.
I am trying to achive:
once user have selected sheet via combobox, (this works)
then i can list the headers from the table on that sheet.
my possible solution idea:
My idea was to list the table headers in a combobox on a userform.
i count columns on selected sheet, works
for loop through the columns to grab the header name from each and stack into combobox.list,
code:
Private Sub chcSite_Change()
Dim siteSheet As String
siteSheet = WorksheetFunction.VLookup(Me.chcSite.Value, Worksheets("Overview").Range("SiteTable"), 2, False)
Me.chcRange.Enabled = True ' enables combobox for headers list
Dim COLS As Integer
COLS = Worksheets(siteSheet).ListObjects(1).ListColumns.Count
Dim i As Integer
i = 1
For i = 1 To COLS
If Worksheets(siteSheet).Cells(Columns(i), 1) = "" Then Exit For ' if header is empty = also end of table cols.
MsgBox Worksheets(siteSheet).Cells(Columns(i), 1) ' debug to see what it returns.
Next i
'Me.chcRange.List = Worksheets(siteSheet).ListObjects(1).ColumnHeads ' random test of columnheads
End Sub
as you can see i was exspecting Worksheets(siteSheet).Cells(Columns(i), 1) to return something, but it appears it is only a pointer/selector.
You might benefit from reading The VBA Guide To ListObject Excel Tables.
For example to get the 3rd heading of a table use
.ListObjects("Table1").HeaderRowRange(3)
The ListObject has its own row/column numbering and may be different from the sheets row/column numbering.
It should look something like this:
Dim i As Long 'always use Long
'i = 1 not needed
For i = 1 To COLS
' v-- this part is not needed …
If Worksheets(siteSheet).ListObjects(1).HeaderRowRange(i) = "" Then
Exit For ' if header is empty = also end of table cols.
End If
' ^-- … because headers of ListObjects can not be empty by definition.
' And HeaderRowRange can only access the headers of the ListObjects.
MsgBox Worksheets(siteSheet).ListObjects(1).HeaderRowRange(i) ' debug to see what it returns.
Next i
So you can shorten it to:
Dim i As Long
For i = 1 To COLS
MsgBox Worksheets(siteSheet).ListObjects(1).HeaderRowRange(i) ' debug to see what it returns.
Next i
Note that Cells(Columns(i), 1) could not work because eg Columns(2) references the complete column B (it is a range representing the full column 2) and Cells needs a row/column number like Cells(row, column).

Loop through name list and if names exist in selection start after last name

I apologize, this is my first crack at Excel VBA so excuse my lack of knowledge!
So I have a list of (currently) 3 names to assign to the days in column A in a repeating order in Excel.
Currently my VBA code allows it to populate the selected cells with the names in a repeating pattern (this part is good), however there are two pieces I need help with.
1- with current code, once it reaches the bottom of the names it checks for the blank box that would end that list and starts over at the tops as directed but it puts a blank cell first (see screenshot). How can I have it put next name without adding blank cell first?
2- I want to be able to (once this gets going)select the entire D column through what dates need to be filled and:
-check the lowest non blank box
-match to list and set the
counter to name below that so
it continues the name order
from the last person who was
assigned
This is code I have now:
Sub EXAMPLE()
Dim count As Integer
count = 0
For Each c In Selection
c.Value = Range("X1").Offset(count, 0).Value
If c.Value = "" Then count = -1 And c.Value = Range("x1").Offset(count, 0).Value
count = count + 1
Next c
End Sub
Sorry I know that was long, I hope this makes sense.
I think it's worth reading about arrays, as this task is ideally suited to their use. Your best bet would be to read the names into an array and then build a recurring array whose dimension is equal to the number of rows in your dates column (or selection, or however you want to define the size of the output range).
Code would look a little like this:
Dim v As Variant
Dim people() As Variant, output() As Variant
Dim rowCount As Long, i As Long, j As Long
Dim endRange As Range
'Read the list of names into an array.
'This just takes all data in column "X" -> amend as desired
With Sheet1
Set endRange = .Cells(.Rows.Count, "X").End(xlUp)
v = .Range(.Cells(1, "X"), endRange).Value
End With
'Sense check on the names data.
If IsEmpty(v) Then
MsgBox "No names in Column ""X"""
Exit Sub
End If
If Not IsArray(v) Then
ReDim people(1 To 1, 1 To 1)
people(1, 1) = v
Else
people = v
End If
'Acquire the number of rows for repeating list of names.
'This just takes all data in column "A" -> amend as desired
With Sheet1
Set endRange = .Cells(.Rows.Count, "A").End(xlUp)
rowCount = .Range(.Cells(3, "A"), endRange).Rows.Count
End With
'Sense check date data.
If endRange.Row < 3 Then
MsgBox "No dates in Column ""A"""
Exit Sub
End If
'Make a recurring array.
ReDim output(1 To rowCount, 1 To 1)
i = 1
Do While i <= rowCount
For j = 1 To UBound(people, 1)
output(i, 1) = people(j, 1)
i = i + 1
If i > rowCount Then Exit Do
Next
Loop
'Write the output to column "D"
Sheet1.Range("D3").Resize(UBound(output, 1)).Value = output

Return text that is different from combo box text

I am setting up a combo box to update a pivot table.
I need the value the combo box returns to be different from the selected text.
For example. You select a product's name in the drop down box, "Cheerios". It has a SKU number of 1234. I need the combo box to return the 1234.
Edit:
Below is an image of where I am getting my list populated from. Column B is what is being displayed in the drop down, column A is what I need returned.
Edit 2:
Private Sub cmb_SkuSelect_Click()
Dim xlSheetSort As Worksheet
Dim lastRow As Long
Dim skuValue As Integer
Set xlSheetSort = ActiveWorkbook.Worksheets("Sort")
lastRow = xlSheetSort.Range("A1").End(xlDown).Row
With xlSheetSort.Range("B1:B" & lastRow)
Set c = .Find(cmb_SkuSelect.Value, LookIn:=xlValues)
If Not c Is Nothing Then
skuValue = xlSheetSort.Range("A" & c.Row).Value
End If
End With
cmb_SkuSelect.Value = ""
ActiveWorkbook.ActiveSheet.Range("A4").Value = skuValue
updatePivot skuValue
End Sub
updatePivot:
Public Sub updatePivot(ByVal sku As Integer)
Dim xlSheet As Worksheet
Dim xlPTable As PivotTable
Set xlSheet = ActiveWorkbook.Worksheets("Sku Inventory")
For Each xlPTable In xlSheet.PivotTables
With xlPTable
.PivotFields("Sku Number").CurrentPage = sku
End With
Next
End Sub
Try that:
Private Sub ComboBox1_Change()
Dim valueToLook As String
valueToLook = ComboBox1.Value
Dim sku, i As Integer
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "B").End(xlUp).Row
End With
For i = 1 To LastRow
If Cells(i, 2).Value = valueToLook Then
sku = Cells(i, 1).Value
MsgBox sku
Exit For
End If
Next i
End Sub
Yes, it's definitely possible - all you need to do is make the combobox a multi-column one, set its BoundColumn to the SKU Number's column and hide that column afterwards. It's a late answer, but it solves your problem.
I'm not going to bother with your existing structure, but rather present a simple example that you can adapt to your needs afterwards. Assuming you already have the form (e.g. UserForm1) and the combobox (e.g. ComboBox1) in a standard workbook, paste this into your userform module:
Private Sub ComboBox1_Change()
' Show the expected result to the user
MsgBox Me.ComboBox1.Value
End Sub
Private Sub UserForm_Initialize()
Dim cbitems(2, 1) As Variant
' Set the number of columns in the combobox to 2 (i.e. Product Name and SKU Number)
Me.ComboBox1.ColumnCount = 2
' Set the 2-nd column's value to be used as the value of the combobox (i.e. the SKU Number)
Me.ComboBox1.BoundColumn = 2
' Set the 2-nd column's width to 0, hiding the column (i.e. only the Product Name is visible)
Me.ComboBox1.ColumnWidths = ";0"
' Populate a 2D array with the values of the combobox columns
cbitems(0, 0) = "Cheerios"
cbitems(0, 1) = "1234"
cbitems(1, 0) = "Apples"
cbitems(1, 1) = "1672"
cbitems(2, 0) = "Peaches"
cbitems(2, 1) = "3722"
' Populate the combobox with the above array, using the List method (i.e. not the AddItem one)
Me.ComboBox1.List = cbitems
' Set the 1-st item of the combobox to be its default one
Me.ComboBox1.ListIndex = 0
End Sub
The comments explain what happens. All you have to do is adapt the code to your usage scenario (e.g. you'll probably want to populate the array/combobox using a loop, maybe move the relevant code to a different Sub than the userform's Initialize event, potentially add column headers if you want both columns to be visible, etc.)
Note: The Change event of the combobox will fire a couple of times when the combobox is first drawn on the userform, so you might get a few empty message-boxes at the start. Don't mind them, the important ones are those after you select some item from the list later on. The message boxes are just for convenience anyway, and, along with the last line in the userform's Initialize event, they can be safely removed from the code once you get the idea.

Getting values from non hidden cells sequentially in excel

I am trying to generate a list of data based on the contents of a group of filtered cells. First (in code not included), users select a criterion from a list box, which filters a list of 800 accounts down to the number that meet that criterion. From there, I need to grab the value from Column a and the row that corresponds to the visible cells. The issue is that I can't do a straight reference to the row, because when the rows are hidden, it is no longer a 1,2,3,4 etc sequential list. Here is the code I have, I know exactly where I need to specify the rows, just not how to do so
Sub AllProviders_Click()
Dim i As Integer
Dim vCount As Integer
vCount = Range("E18:E817").SpecialCells(xlCellTypeVisible).Count
MsgBox vCount 'for debugging
For i = 1 To vCount
Sheets("Provider Output").Cells(3, 2 + i) = 'and this is where I have no idea
Next i
End Sub
When the sub is run, the number of cells that are visible is stored in vCount, which is used to specify how many columns of data are going to be filled. My issue is line 7, where I need to specify the cells to pull.
Try:
Range("A18:A817").SpecialCells(xlCellTypeVisible).Copy _
Sheets("Provider Output").Cells(3, 3)
Edit: if that's not working for you then maybe try this -
Sub AllProviders_Click()
Dim i As Integer
Dim c As Range
i = 1
For Each c In Range("E18:E817").Cells
If Not c.EntireRow.Hidden Then
Sheets("Provider Output").Cells(3, 2 + i) = c.EntireRow.Cells(1).Value
i = i + 1
End If
Next c
End Sub

Resources