I need to pull text with formats from a worksheet into the Userform. I am able to pull plain text, but not able to retrieve text with formatting. Could you please suggest a code for that?
My code
Based on the text input in ComboBox2, a corresponding search result will appear in the two text boxes.
Private Sub ComboBox2_Change()
If Len(ComboBox2.Text) > 1 Then
search1
End If
End Sub
Private Sub search1()
Dim erow As Long
Dim ws As Worksheet
Dim lastrow As Long
Dim count As Integer
Dim temp As String
lastrow = Sheets("Sheet3").Cells(Rows.count, 1).End(xlUp).Row
count = 0
For X = 2 To lastrow
If Sheets("Sheet3").Cells(X, 1) = ComboBox2.Text Then
TextBox2.Text = Sheets("Sheet3").Cells(X, 2)
TextBox4.Text = Sheets("Sheet3").Cells(X, 3)
count = count + 1
End If
Next X
Related
I am currently struggling with the following marco. I am trying to find a string in a data sheet that is taken from a userform textbox and if the string is found, I would like to copy the row and paste it into the sheet "results", then look for the string the the next row. The location of the string is in column A.
Yet, I never get any results, even when trying with just two entries of data. Could anyone help me with this issue?
Any tips would be appreciated. Many thanks in advance,
Nic
Private Sub CommandButton1_Click()
Dim uiValue As String
uiValue = Trim(ticker.Text)
Dim Sheet As Worksheet
Dim results As Worksheet
Dim LastRow As Long
Dim LastColumn As Long
Dim StartCell1 As Range
Dim i As Integer
Set results = Worksheets("Results")
Set Sheet = Worksheets("Database")
LastRow = Sheet.Cells(Rows.Count, 1).End(xlUp).Row
Sheet.Activate
For i = 2 To LastRow
If Cells(i, 1) = uiValue Then
Range(Cells(i, 2), Cells(i, 15)).Copy results.Range("A4000").End(xlUp).Offset(1, 0)
Sheet.Select
End If
Next i
End Sub`
In my vba code below I am trying to delete to specific colors from a row. Right now I would like to combine 2 if statements into 1 if statement. Right now my code below is working but is inefficient if more colors are added. Look for the if statements regarding blue and red for this problem.
Sub collapse_columns()
Dim x As Integer
For x = 1 To 4
collapse_column x
Next
End Sub
Sub collapse_column(column_number As Integer)
Dim row As Long
Dim s As Worksheet
Dim last_row As Long
Set s = ActiveSheet ' work on the active sheet
'Set s = Worksheets("Sheet1") 'work on a specific sheet
last_row = ActiveSheet.Cells(s.Rows.Count, column_number).End(xlUp).row
For row = last_row To 1 Step -1
If Cells(row, column_number).Value = "red" Then Cells(row, column_number).Delete xlUp
Next
For row = last_row To 1 Step -1
If Cells(row, column_number).Value = "blue" Then Cells(row, column_number).Delete xlUp
Next
End Sub
When I have many possible values that can trigger the same code, I like to use a string to hold the values, then search the string to find a match as follows:
Sub collapse_column(column_number As Integer)
Dim row As Long
Dim s As Worksheet
Dim last_row As Long
Set s = ActiveSheet ' work on the active sheet
'Set s = Worksheets("Sheet1") 'work on a specific sheet
last_row = ActiveSheet.Cells(s.Rows.Count, column_number).End(xlUp).row
Dim colors_to_delete As String
colors_to_delete = ",red,blue," ' be sure to keep the leading and trailing commas
For row = last_row To 1 Step -1
If InStr(1, colors_to_delete, "," & Cells(row, column_number).Value & ",") > 0 Then Cells(row, column_number).Delete xlUp
Next
End Sub
I have two set of range named as LIST_KEY and LIST_CAT. In Column A, user will add some data which will contain one of the one of the text from LIST_KEY. I would like to get corresponding Category list from LIST_CAT depends upon the Key value
I am using below VBA code to achieve this. This include a Array formula.
Sub match()
Dim ss As Workbook
Dim test As Worksheet
Set ss = Excel.Workbooks("test.xlsm")
Set test = ss.Worksheets("Sheet1")
For i = 2 To test.Cells(Rows.Count, "A").End(xlUp).Row
Cells(i, "B").FormulaArray = "=INDEX(LIST_CAT,MATCH(TRUE,ISNUMBER(SEARCH(LIST_KEY,RC[-1])),0))"
Cells(i, "B").Formula = Cells(i, "B").Value
Next i
End Sub
This code works perfect if there is less data to fetch. But in my original use case, I will have around 8000 rows. Due to this large number of columns excel will go to not responding state after 2-3 minutes.
Instead of adding Array formula to column B, Is there anyway to convert that into VBA to run this faster. Sorry, I am new to this VBA stuff and dont have much experience
Try the following code, which uses arrays instead of worksheet formulas...
Option Explicit
Sub GetCategories()
Dim sourceWorkbook As Workbook
Set sourceWorkbook = Workbooks("test.xlsm")
Dim sourceWorksheet As Worksheet
Set sourceWorksheet = sourceWorkbook.Worksheets("Sheet1")
Dim lookupArray As Variant
lookupArray = sourceWorkbook.Names("LIST_KEY").RefersToRange.Value
Dim returnArray As Variant
returnArray = sourceWorkbook.Names("LIST_CAT").RefersToRange.Value
Dim tableArray As Variant
Dim lastRow As Long
With sourceWorksheet
lastRow = .Cells(.Rows.Count, "a").End(xlUp).Row
tableArray = .Range("A2:B" & lastRow).Value
End With
Dim desc As String
Dim i As Long
Dim j As Long
For i = LBound(tableArray, 1) To UBound(tableArray, 1)
desc = tableArray(i, 1)
For j = LBound(lookupArray, 1) To UBound(lookupArray, 1)
If InStr(1, desc, lookupArray(j, 1), vbTextCompare) > 0 Then
tableArray(i, 2) = returnArray(j, 1)
Exit For
End If
Next j
Next i
sourceWorksheet.Range("B2").Resize(UBound(tableArray, 1), 1).Value = Application.Index(tableArray, 0, 2)
End Sub
I have a background in PHP and .Net but I am new to VBA. Is it possible to add specific column cells in excel coming from listbox in userform? Thanks.
I already manage to insert a new column coming from userform. This is my code.
Private Sub btnSaveParameters_Click()
Dim totalParameters As Integer
totalParameters = ListBox1.ListCount
Dim lColumn As Long
Dim addlColumn As Long
Dim ws As Worksheet
Set ws = Worksheets("Reference")
Dim i As Integer
i = 0
Do Until i >= Me.ListBox1.ListCount
MsgBox "The vaue of i is: " & ListBox1.List(i)
lColumn = ws.Cells(3, ws.Columns.Count).End(xlToLeft).Column
addlColumn = lColumn + 1
ws.Cells(3, addlColumn).Value = Me.ListBox1.List(i)
i = i + 1
Loop
End Sub
After running the Userform_Initialize() event, there would be nothing populated in the listbox as shown below:
There should be 11 columns populating the listbox based on the excel table below:
The code ran:
Private Sub UserForm_Initialize()
Dim Total_rows_FoilProfile As Long
Dim row As Range, i As Long
Total_rows_FoilProfile = TotalRowsCount(ThisWorkbook.Name, "Foil Profile", "tblFoilProfile")
ReDim MyArr(0 To Total_rows_FoilProfile - 1)
For Each row In ThisWorkbook.Worksheets("Foil Profile").ListObjects("tblFoilProfile").Range.SpecialCells(xlCellTypeVisible).Rows
MyArr(i) = row.Value
i = i + 1
Next row
lbxFoilInfoDisplay.List = MyArr
frmFoilPanel.Show
The properties of the listbox:
You can populate each list row and then add the columns to it:
Option Explicit
Private Sub UserForm_Initialize()
Dim tblFoilProfile As ListObject
Set tblFoilProfile = ThisWorkbook.Worksheets("Foil Profile").ListObjects("tblFoilProfile")
Dim i As Long
lbxFoilInfoDisplay.Clear
Dim iListRow As Range
For Each iListRow In tblFoilProfile.DataBodyRange.SpecialCells(xlCellTypeVisible).Rows
With Me.lbxFoilInfoDisplay
.AddItem iListRow.Cells(1, 1).Value 'add first value (column 1)
Dim iCol As Long
For iCol = 2 To iListRow.Columns.Count 'add all other columns to that row
.list(i, iCol) = iListRow.Cells(1, iCol).Value '.Value for unformatted value or .Text to show it in the same format as in the cell
Next iCol
i = i + 1
End With
Next iListRow
End Sub
Note here is a nice guide how to work with list objects.