I would like to generate new sheet for all values contains "_S" :
Example:
When user click on "Generate page", two new sheet are created (one sheet with title "Folder22_S" and other one with title "Folder3_S"
In second time, i would like that new sheet generated from a model (not generate a empty sheet)
My question is: How to do this ? I doesn't know how to find all values contains "_S" and get cell value ( Folder22_S and Folder3_S) ?
My pseudo VBA code:
Sub generate()
'Array contains all values *_S'
Dim AllValuesContains_S As Variant
AllValuesContains_S = Array("Folder22_S", "Folder3_S", ...)
For Each item As String In AllValuesContains_S
Sheets.Add.Name = item
Next
End Sub
I will assume the range you want to search is A2:C7. Adjust that portion of the code to be whatever range you need.
Sub New_Wksht()
Dim SearchRange as Range, c as Range
Dim sht as Worksheet
With ThiwWorkbook
Set SearchRange = .Sheets("Your Sheet Name").Range("A2:C7") 'Change sheet name and range to be what you need
For Each c in SearchRange
If Right(c.Value,2) = "_S" Then
Set sht = .Sheets.Add
sht.Name = c.Value
End If
Next C
End With
End Sub
Related
I would need to open a random selected link from a cell to a website in my list. My internet links are put in column B, but I cannot get it to open the hyperlink after it has selected a cell from my list.
Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Set Sh = Worksheets("Sheet1")
With Sh
Set Rng = .Range("C1:C" & .Cells(.Rows.Count, "C").End(xlUp).Row)
End With
For Each Cell In Rng
ThisWorkbook.FollowHyperlink Cell.Value
Next Cell
End Sub
Just to be sure I got it right:
The addresses are stored in column B (in your code you're using column C)
You don't want to open all of the addresses, but only one random one?
The addresses are full URLs? (Like "https://stackoverflow.com/")
I tidied up your code a little bit. Read the comments, to understand what is happening.
Sub Test()
Dim Sh As Worksheet
Dim Rng As Range
Dim Cell As Range
Set Sh = Worksheets(1)
' Get a Range object of all possible addresses
Set Rng = Intersect(Sh.UsedRange, Sh.Range("B:B"))
' Open one random element of them
ThisWorkbook.FollowHyperlink Rng(Int(Rnd * Rng.Count) + 1)
End Sub
I have a list of items and a new sheet button like this:
For each item you have to be able to create new worksheet when you click on that button. It copies a worksheet from a template, one worksheet for a single row. Now i want to be able to copy some of the info from a row i select to that new worksheet cells when i click on the button and maybe rename the worksheet as a value in one of the cells (ID). The values i need are ID and name, maybe few more.
Sub AddNameNewSheet2()
Dim CurrentSheetName As String
CurrentSheetName = ActiveSheet.Name
'Add New Sheet
Dim i As Byte, sh As Worksheet
For i = 1 To 1
Sheets("Predlozak").Copy After:=Sheets("Predlozak")
Set sh = ActiveSheet
Next i
On Error Resume Next
'Get the new name
ActiveSheet.Name = InputBox("Name for new worksheet?")
'Keep asking for name if name is invalid - Here i want to change worksheet name to a specific cell value from selected row.
Do Until Err.Number = 0
Err.Clear
ActiveSheet.Name = InputBox("Try Again!" _
& vbCrLf & "Invalid Name or Name Already Exists" _
& vbCrLf & "Please name the New Sheet")
Loop
On Error GoTo 0
End Sub
Anyone has an idea how can i make this work?
Here's what I came up with, I also thought checkboxes would be a good way to pick the line, it's quite simple:
Sub AddNameNewSheet2()
Dim x As Long
Dim wks As Worksheet
Dim IdCell As Range, NamCell As Range, FormCell As Range
Set wks = ActiveSheet
Set IdCell = wks.Range("A:A").Find("TRUE").Offset(0, 1)
Set FormCell = IdCell.End(xlToRight)
Set NamCell = IdCell.Offset(0, 1)
Sheets.Add After:=Sheets(1), Type:= _
"C:\Users\*yournamehere*\AppData\Roaming\Microsoft\Templates\*yourtemplatehere*.xltm"
ActiveSheet.Name = NamCell
Dim wks2T As ListObject
Set wks2T = ActiveSheet.ListObjects(1)
With wks2T
.ListColumns(1).Range(2) = IdCell.Value
.ListColumns(2).Range(2).Value = NamCell.Value
.ListColumns(3).Range(2).Value = FormCell.Value
End With
End Sub
I made the template a table cause it is easier to specify exactly where to put stuff. And it is more manageable as more data is added in the future.
Sheet1 image
Sheet2 image
Good Morning.
I have a workbook with multiple worksheets in it. Lets say worksheet A & B
In worksheet B I have multiple supplier columns some of them have X's in them and some of them don't
What I would like to know how to do is to be if there is an "X" present in the column then look to the leftmost Column (A) and look for that part number in Worksheet A.
When it finds the part number in Worksheet A, I would like to copy all of the rows and columns associated with it and paste it into a brand new workbook.
Typically the part number is showing on multiple rows let's say rows 1-6 and the information I'd like to copy spans across multiple columns Let's say to Column "T".
Your question is not to clear.
Assuming that you mean you have one workbook with a worksheet named A and a worksheet named B, the algorithm you describe is something like this:
Sub Test()
Dim wb as Workbook
Dim wsA as Worksheet
Dim wsB as Worksheet
Dim suppliersRange as Range
Dim xRange as Range
Dim searchValue as string
Dim foundRange as Range
'The two worksheets in the initial book:
Set wsA = ThisWorkbook.Worksheets("A")
Set wsB = ThisWorkbook.Worksheets("B")
'The supplier column to search:
Set suppliersRange = wsB.Range("D:D") 'let's assume it column D for now.
Set xRange = suppliersRange.Find("X") 'Find "X"
If not xRange is nothing then
searchValue = wsB.Range("A" & xRange.Row).value 'Get the value from column A to do the next search
End If
Set foundRange = wsA.UsedRange.Find(searchValue) 'Search for this number that we got with the previous step.
If not foundRange is nothing then 'If it's found
Set wb = Workbooks.Add 'Create a new workbook
wsA.UsedRange.Copy wb.Worksheets(1).Range("A1") 'And copy Sheet A in there
End If
Set foundRange = Nothing
Set xRange = Nothing
Set suppliersRange = Nothing
Set wsA = Nothing
Set wsB = Nothing
Set wb = Nothing
End Sub
Note that since you do not specify what you mean with "multiple rows for a part" and/or what columns, etc. - I just copy the entire sheet contents. Of course you can filter out the actual range to copy, but this code for sure does the searches for you, creates the new workbook and copy-pastes from your Sheet A.
I have an excel file with 3 worksheets: (1) Report, (2) category-1 and (3) category-2.
"Report" worksheet contains summary information of category-1 and category-2 data with unique ID of each category and grouping values. See attached example image.
I need to copy unique value from "Category1SubId" column of "Category1" worksheet to "Report" worksheet in "column-D" and then copy relevant value of "Category1Value" from "Category1" worksheet into "Report" worksheet in "Column-E".
For example, formula / VBA code to copy values from 1,2,3,4,5 for Apple into "Report" worksheet from "Category1" worksheet, and then copy "Breakfast" value for combination of "Apple and 1" into cell-E2 of Report worksheet from Category-1 worksheet and so on.
I tried combination of INDEX, VLOOKUP, ROWS and SEARCH formulas but none of them helped. I also tried VBA code to do it, but it didn't work.
Can anyone please help to solve this puzzle either through formula or VBA code?
Example of this worksheet is attached here.
I tried following VBA code
Sub CopyData()
Dim category1LookupValueRange As Range
Dim category2LookupValueRange As Range
Dim category1SourceRange As Range
Dim category2SourceRange As Range
Dim category1TargetRange As Range
Dim category2TargetRange As Range
Dim targetValue As String
Set category1LookupValueRange = Worksheets("Report").Range("C2:C30")
Set category2LookupValueRange = Worksheets("Report").Range("F2:F30")
Set category1SourceRange = Worksheets("Category1").Range("A2:C30")
Set category2SourceRange = Worksheets("Category2").Range("A2:C30")
Set category1TargetRange = Worksheets("Report").Range("D2:E30")
Set category2TargetRange = Worksheets("Report").Range("G2:H30")
Dim iRow As Integer
Dim category1LookupValue As Object
Dim category1Id As Object
Dim category1IdValue As Object
Dim category2LookupValue As Object
Dim category2Id As Object
Dim category2IdValue As Object
For iRow = 1 To category1LookupValueRange.Count
Set category1LookupValue = category1LookupValueRange.Cells(iRow, 1)
Set category2LookupValue = category2LookupValueRange.Cells(iRow, 1)
Set category1Id = category1SourceRange.Range.Cells(category1SourceRange.Find(category1LookupValue, LookAt:=xlWhole), 1)
Set category2Id = category2SourceRange.Range.Cells(category2SourceRange.Find(category2LookupValue, LookAt:=xlWhole), 1)
Set category1IdValue = category1SourceRange.Range.Cells(category1SourceRange.Find(category1LookupValue, LookAt:=xlWhole), 1)
Set category2IdValue = category2SourceRange.Range.Cells(category2SourceRange.Find(category2LookupValue, LookAt:=xlWhole), 1)
If Not (category1LookupValue Is Nothing) Then
If (category1SourceRange.Cells(iRow, 1) = category1LookupValue) Then
Set category1TargetRange.Range.Cells(iRow, 1) = category1Id
Set category2TargetRange.Range.Cells(iRow, 1) = category2Id
End If
End If
Next iRow
Following array formula in Cell range D2 to D30 in Report worksheet
{=IF(ISERROR(SMALL(IF(IF(ISERROR(SEARCH($C2,Category1!$A$2:$A$30)),FALSE,TRUE),ROW(Category1!$B$1:$B$30)),ROW(Category1!$B$1:$B$30))),"",INDEX(Category1!$A$2:$C$100,SMALL(IF(IF(ISERROR(SEARCH($C2,Category1!$A$1:$A$30)),FALSE,TRUE),ROW(Category1!$B$1:$B$30)),ROW(Category1!$B$1:$B$100)),1))}
I am wondering if someone can help me out. I created a Userform with 3 comboboxes. Combobox 1 and 2 list all open workbooks. Combobox 3 lists the worksheets from Combobox 2. I now want to run a Vlookup. The lookup values are the values (in this case product codes) in each cell beginning at D9 to the last cell with a value in Column D of the first Worksheet of Combobox2's. The lookup range will be ("A5:S###"[number of rows varies depending on the file]").
The Vlookup formula should be in the Column I of the first Worksheet of Combobox2's value starting at "I9" looping through each cell in I9 until all the Codes in D9 are looked up.
I keep getting error the major one being “Runtime-error '9'”: Subscript out of range. Here is my code.
Option Explicit
Private Sub CancelButton_Click()
Stopped = True
Unload Me
End Sub
Private Sub ComboBox1_Change()
Dim ScheduleA As Workbook
Dim Termset As Worksheet
Set ScheduleA = Workbooks(Me.ComboBox1.Value)
With Me.ComboBox3
For Each Termset In ScheduleA.Worksheets
.AddItem Termset.Name
Next Termset
End With
End Sub
Private Sub FillACDButton_Click()
Dim ACDRebateInfo As Worksheet
Dim lastRow As Long
Dim NewRebate As Single
Dim NewRebateType As String
Dim LookUp_Range As Range
Dim ActionCode As String
Dim ACD_NewRebate As Range
Dim ACD_NewRebateType As Range
Dim ACD_ActionCode As Range
Dim SCC As Range
Dim Cell As Range
Set ACDRebateInfo = Workbooks(Me.ComboBox2.Value).Worksheets(1)
Set ACD_NewRebate = ACDRebateInfo.Range("I9:I500")
Set ACD_NewRebateType = ACDRebateInfo.Range("J9:J500")
Set ACD_ActionCode = ACDRebateInfo.Range("B9:B500")
Set LookUp_Range = Worksheets(Me.ComboBox3.Value).Range("A5:S400")
Set SCC = ACDRebateInfo.Range("D9:D230")
With ACDRebateInfo
For Each Cell In ACD_ActionCode
ActionCode = Application.WorksheetFunction.VLookup(SCC, LookUp_Range, 17, False)
Next Cell
End With
Unload Me
End Sub
Private Sub UserForm_Initialize()
Dim wkb As Workbook
For Each wkb In Application.Workbooks
Me.ComboBox1.AddItem wkb.Name
Me.ComboBox2.AddItem wkb.Name
Next wkb
End Sub
Not sure this is your issue but this piece of code does not make sense:
For Each Cell In ACD_ActionCode
ActionCode = Application.WorksheetFunction.VLookup(SCC, LookUp_Range, 17, False)
Next Cell
You are looping through the Action Codes but not using the Cell variable