String comparison using Like an wildcard not working - excel

I have data in some cells in column B that look like Id# plus some number e.g 'Id# 85'
All the other cells have names in them FirstName LastName
I need to find the cells that have Id# in them, I am trying the following, but not working
Thanks
Sub test()
Dim ws As Worksheet
Dim i As Long
Set ws = ThisWorkbook.Sheets("Elements")
With ws
For i = 2 To 180
If .Cells(i, "B").Text Like "Id#" & "*" Then Do something
Next i
End With
End Sub

Try this:
Sub test()
Dim ws As Worksheet
Dim i As Long
Set ws = ThisWorkbook.Sheets("Elements")
With ws
For i = 2 To 180
If Left(.Cells(i, "B").Text, 3) = "Id#" Then
.Cells(i, "C").Value = True
End If
Next i
End With
End Sub

Related

How to use information from a ComboBox in another one?

I'm trying to make a UserForm with comboboxes and textboxes. I have two combobox that are working together. In the first one you choose the right sheet and in the second you choose the right column in the selected sheet.
My problem is that even though my code is working, the second combobox doesn't use the moving information from the first one. It always displays the columns from the first sheet whatever my choice. So how do I get the data from the first one to use it in the second one?
Here's my code:
Private Sub UserForm_Initialize()
Dim I As Long
Me.ComboBox1.Clear
For I = 7 To Sheets.Count
Me.ComboBox1.AddItem Sheets(I).Name
Next
Me.ComboBox1.Value = ActiveSheet.Name
Me.ComboBox2.Clear
Dim j As Integer
Dim puits As String
j = 3
Do While Worksheets(ComboBox1.Text).Cells(1, j).Value <> ""
Me.ComboBox2.AddItem Worksheets(Me.ComboBox1.Text).Cells(1, j).Value
j = j + 3
Loop
End Sub```
EDIT
[USF is to automate the change of the selected cell in this screenshort, same tables on different sheets][1]
[1]: https://i.stack.imgur.com/7bbQG.png
You need to use the Combobox_Change-Event. This Example shows what I mean:
Private Sub ComboBox1_Change()
Dim ws As Worksheet
Dim lCol As Long, i As Long
Set ws = ThisWorkbook.Worksheets(UserForm1.ComboBox1.Value)
lCol = ws.Cells(1, ws.Columns.Count).End(xlToLeft).Column
For i = 1 To lCol
UserForm1.ComboBox2.AddItem ws.Cells(1, i).Value
Next
End Sub
Private Sub UserForm_Initialize()
Me.ComboBox1.Clear
Me.ComboBox2.Clear
Dim ws As Worksheet
Dim i As Long
i = 1
For Each ws In ThisWorkbook.Worksheets
Me.ComboBox1.AddItem ws.Name
i = i + 1
Next ws
End Sub
When I select the Sheet, I change the first Combobox, which triggers the Change-Event. And I then populate the second Combobox according to the selected sheet.
EDIT
You could insert a CommandButton and use code like the following:
Private Sub CommandButton1_Click()
Dim ws As Worksheet
Dim rng As Range
Set ws = ThisWorkbook.Worksheets(UserForm1.ComboBox1.Value)
Set rng = ws.Range(UserForm1.ComboBox2.Value)
rng.Value = "Your Date"
End Sub

Find/select today's date from list of 366 days in column A

I made a calendar sheet in Excel with all 366 days of the year listed in column A
how can I write an Auto_open macro which automatically selects and activates the cell holding the current date?
Give this a try:
Private Sub Workbook_Open()
Dim cell As Range
Sheets("Sheet1").Activate
Set cell = Range("A:A").Find(What:=Date, After:=Range("A1"))
cell.Select
End Sub
I'd write it as:
Private Sub Workbook_Open()
Dim CellToCheck As Range
For Each CellToCheck In Sheet1.Range("A1:A366") 'To make dynamic, you could make use of finding lastrow and searching until that row.
If CellToCheck.Value = Date Then
CellToCheck.Select
Exit For
End If
Next CellToCheck
End Sub
Outcome:
For this code to work you need to enter it into the ThisWorkbook code module and choose Workbook and Open from the appropriate drop-down menus, like so:
Private Sub Workbook_Open()
Dim lastrow As Long
Dim lastcol As Long
Dim t As Date
Dim u As Date
Dim v As Long
Dim w As Long
Dim notolet As String
Sheets("all").Activate ' your sheet name here
With ActiveSheet
lastrow = .Cells(Rows.Count, "A").End(xlUp).Row
lastcol = .Cells(1, Columns.Count).End(xlToLeft).Column
End With
t = Now()
u = Format(t, "dd/mm/yyyy")
notolet = Split(Cells(1, lastcol).Address, "$")(1)
For v = lastrow To 2 Step -1
Select Case Cells(v, 1).Value
Case u
Range("A" & v & ":" & notolet & v).Interior.ColorIndex = 6
Exit For
End Select
Next
w = v
End Sub

Copy specific sheet names from range

I need help and I'm hoping someone here can help me :)
I have a workbook that runs some reports from Avaya CMS. It runs the report and creates a new sheet for each persons name on the MAIN sheet. << This part works wonderfully.
My issue is I cannot figure out how to use that range of names on the MAIN sheet to select only those specific sheets and then copy them to a new workbook.. There's 2 other hidden sheets as well.. Which is why I think using the range of names is easier but I'm open to anything at this point.
Here's an screeshot of what it looks like :
Sorry, I couldn't figure out how to upload the workbook here but the image should, hopefully, be good enough. Thank you for your time and help!
Here's an image with the hidden sheets.
I need it to exclude the first 3 sheets/
And here's the code:
Sub Macro1()
Dim sheetArray() As String
Dim i As Integer
i = 0
For Each c In MainSheet.Range("A2:A20").Cells
ReDim Preserve sheetArray(0 To i)
sheetArray(i) = c.Value
i = i + 1
Next
Sheets(sheetArray).Select
End Sub
Sub move_Sheets()
Dim mSH As Worksheet
Set mSH = ThisWorkbook.Sheets("Main")
Dim shArray() As String
Dim i As Integer
i = mSH.Range("A" & Rows.Count).End(xlUp).Row
ReDim Preserve shArray(0 To i - 2)
For a = 2 To i
shArray(a - 2) = mSH.Range("A" & a).Value
Next a
ThisWorkbook.Sheets(shArray).Move
End Sub
You could try:
Option Explicit
Sub test()
Dim LastRow As Long, i As Long, sheetIndex As Long
Dim SheetName As String
Dim ws As Worksheet
With ThisWorkbook.Worksheets("Main")
'Last row of column where the names appears
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
'Loop the column from row 2 to last row
For i = 2 To LastRow
'Set Sheet name
SheetName = .Range("A" & i).Value
'Check if the sheet with the SheetName exists
If DoesSheetExists(SheetName) Then
'Insert the code to code
sheetIndex = Workbooks("Book2").Sheets.Count
ThisWorkbook.Worksheets(SheetName).Copy After:=Workbooks("Book2").Sheets(sheetIndex)
Else
End If
Next i
End With
End Sub
Function DoesSheetExists(SheetName As String) As Boolean
Dim ws As Worksheet
On Error Resume Next
Set ws = ThisWorkbook.Sheets(SheetName)
On Error GoTo 0
If Not ws Is Nothing Then DoesSheetExists = True
End Function

VBA: Method or Data member not found. FindString for Combobox

I get this error when I am trying to open a UserForm. What I want is to add to a combobox all the different objects (not repeated) that are present in a column.
I have been looking some solutions around there and all I can say until now is Yes, I have a combobox called "offer1"
When it gives me the error, it highlight the .FindString() method inside the loop
Private Sub UserForm_Initialize()
Dim rCell As Range
Dim i As String
Dim ws As Worksheet
Dim text As String
text = rCell.text
ws = Offers
offer1.Clear
With offer1
For Each rCell In Sheets("Offers").Range("A2", Sheets("Offers").Cells(Rows.Count, "A").End(xlUp))
If TEST.offer1.FindString(text) = -1 Then
.AddItem CStr(text)
End If
Next rCell
End With
End Sub
(If you see some silly mistakes with the names of variables as "Ofertas" or something like that is probably that I translated some variable names to english, and I jumped over a few)
Thanks a lot
Replace your code with this:
Option Explicit
Private Sub UserForm_Initialize()
Dim rCell As Range
Dim ws As Worksheet
Dim LastRow As Long
Dim strFirstCell As String
Set ws = Sheets("Offers")
With Me.offer1
.Clear
LastRow = ws.Cells(Rows.Count, "A").End(xlUp).Row
strFirstCell = ws.Cells(2, "A").Address
For Each rCell In ws.Range(strFirstCell, ws.Cells(Rows.Count, "A").End(xlUp))
If Evaluate("=SUMPRODUCT((" & strFirstCell & ":" & rCell.Address(0, 0) & "=" & rCell.Address & ")+0)") = 1 And rCell.Value <> "" Then
.AddItem rCell.Value
End If
Next rCell
End With
End Sub
This will fill your combobox with all the unique items in column A, starting at row 2, while also skipping any blanks.

Getting type mismatch error when setting Worksheet.Name to a cell.value in VBA

I have written the following code to create worksheet with names same as the names in first column of Sheet1
I am getting a TypeError when trying to set the name on the new worksheet but don't know why. Can someone help?
Sub CreateWorkSheets()
'
' Macro5 Macro
'
'
Dim r As Range
Set r = Sheets("Sheet1").Columns(1)
For Each cell In r
Dim aa As String
Dim newSheet As Worksheet
Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
strTemp = cell.Value
newSheet.Name = strTemp // Error Here
Next cell
End Sub
I tried the following code as well and that doesn't work either even though strValue is valid
Sub Test1()
Sheets("Sheet1").Select
Dim x As Integer
' Set numrows = number of rows of data.
NumRows = Range("A2", Range("A2").End(xlDown)).rows.Count
' Select cell a1.
Range("A2").Select
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
Dim newSheet As Worksheet
Set newSheet = Sheets.Add(After:=Sheets(Sheets.Count))
Sheets("Sheet1").Range("B1").Value = "A" + Trim(Str(x))
strValue = "A" + Trim(Str(x))
newSheet.Name = Str(Sheets("Sheet1").Range(strValue).Value)
Next
End Sub
Apparently because you set:
Set r = Sheets("Sheet1").Columns(1)
It set the cell object to column $A:$A instead of $A$1 like you would think. I put this in the immediate window when I ran into the "cell.value" line:
?cell.Address
$A:$A
You should avoid using an entire column to do what you're trying to do and I would highly recommend you add these keywords to the top of your module:
Option Explicit
This will check your code a little more thoroughly and help you avoid unwanted errors.
To fix this, you can get the exact range you need and I recommend you declare every variable so it stays a specific type.
Something like this:
Option Explicit
Sub CreateWorkSheets()
Dim r As Range
Dim sh As Worksheet
Dim tempSh As Worksheet
Dim cell As Range
Dim strTemp As String
Set sh = Sheets("Sheet1")
Set r = sh.Range(sh.Cells(1, 1), sh.Cells(sh.Rows.Count, 1).End(xlUp))
For Each cell In r
Set tempSh = Sheets.Add(After:=Sheets(Sheets.Count))
strTemp = cell.Value
tempSh.Name = strTemp '// no more error
Next cell
End Sub

Resources