I'm working on a code and everything is working fine but I need to set vlookup value from a variable sheet Name with the same structure
I tried many syntax with no use any advise.
This a portion of the code which is related to my issue.
'Selecting Pervious Month Sheet (From Feb to Dec)
srIndex = Application.Match(CLng(InputValue) - 1, IndexRange, 0)
sMonth = MonthResultRg.Cells(srIndex)
For Each DestinationWs In wb.Worksheets
If InStr(1, DestinationWs.Name, sMonth, vbTextCompare) > 0 Then Exit For
Next DestinationWs
Dim SheetName As Variant: SheetName = DestinationWs.Name
Dim StringVal As String: StringVal = CStr(SheetName)
Dim OldRemainingHoursLastRowFirst As Variant: OldRemainingHoursLastRowFirst = DestinationWs.Range("W3").End(xlDown).Row
'Selecting the Desired Sheet Again which Selected First To Paste The Selection
srIndex = Application.Match(CLng(InputValue), IndexRange, 0)
sMonth = MonthResultRg.Cells(srIndex)
For Each DestinationWs In wb.Worksheets
If InStr(1, DestinationWs.Name, sMonth, vbTextCompare) > 0 Then Exit For
Next DestinationWs
DestinationWs.Range("L4").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],INDIRECT(""'" & StringVal & "'!R[" & OldRemainingHoursLastRowFirst & "]C[12]:R[" & OldRemainingHoursLastRowFirst & "]C[14]"",0),2,0)"
Simply this part of the whole code takes the input value and selecting the Month reference based on this value.
Then if the input value is 2 which refers to Feb Month , then it will vlookup the needed data from Sheet Name (Jan)
Then paste the vlookup data into Feb Month which is totally dynamic based on the variable Sheet Name which is defined as variant.
Too many quotes?
Dim SheetName As Variant
SheetName= DestinationWs.Name
DestinationWs.Range("L4").FormulaR1C1 = "=IFERROR(VLOOKUP(RC[-2],INDIRECT('" & _
SheetName & "'!R[" & OldRemainingLastRowFirst & "]C[12]:R[" & _
OldRemainingLastRowFirst & "]C[12]), 2, 0)"
Related
Suppose you have an excel workbook with 30 sheets, and you would like to extract data from the range A1:K40 from every sheet into that workbook, and then add all of the extracted data into a single excel sheet in a different workbook. Would this be possible?
I would like to build it such that the user is prompted to select a file, and the file selected will be of the same format, a workbook with 28-31 sheets, and complete the function as previously stated. An additional feature I'd like to add would be when the user selects the workbook, they will be prompted to select which sheets to extract data from within that workbook.
I'd appreciate if anyone could direct me to similar example or even better, just guide me on which vba functions would be best to make this work.
Please, try the next way. It will create a string composed by concatenation of all sheets name with their index and the user is asked to choose the index of sheets to have ranges copied. They should choose them writing the index separated by comma (2,5,9,12). In case of more consecutive sheets, they can use 2,5,9-12,15, 9-12 meaning sheets form 9 to 12 (9,10,11,12). You should configurate the code using the sheets name where the ranges to be copied **instead "AllSheets" generically used in the code):
Sub CopySomeSheets()
Dim wbC As Workbook, wb As Workbook, ws As Worksheet, wsCopy As Worksheet, lastR As Long
Dim strAllSheets As String, strSelSheets As String, arrSheets, i As Long
Set wbC = ActiveWorkbook 'use here the workbook where from to copy sheets
Set wb = ThisWorkbook 'use here the workbook where to copy all ranges
Set ws = wb.Worksheets("AllSheets") 'the sheet where all ranges should be pasted!!!
'create the list of all sheets from whitch to choose the ones to be copied:
For i = 1 To wbC.Sheets.count
strAllSheets = strAllSheets & wbC.Sheets(i).name & " - " & i & vbCrLf
Next i
strSelSheets = InputBox("Please, select the sheets to be copied." & vbCrLf & _
"Use the sheets number (after its name) separated by comma ("","")." & vbCrLf & _
"More consecutive sheets should be represented as ""5-8"", which means sheets 5,6,7,8." & _
vbCrLf & vbCrLf & strAllSheets, _
"Make sheets selection")
If strSelSheets = "" Then MsgBox "You did not select any sheet...": Exit Sub 'in case of pressing Cancel or Top right X
arrSheets = makeSheetsArray(Split(Replace(strSelSheets, " ", ""), ","), wbC) 'make an array of sheets indexes
'copy the ranges from above selected sheets:
Application.ScreenUpdating = False: Application.Calculation = xlCalculationManual 'a little optimization
For i = 0 To UBound(arrSheets)
lastR = ws.Range("A" & ws.rows.count).End(xlUp).row 'lastr row on A:A
If lastR > 1 Then lastR = lastR + 1 'first range is copying starting from A1, the rest in the next empty row
wbC.Worksheets(CLng(arrSheets(i))).Range("A1:K40").Copy ws.Range("A" & lastR) 'copy the range
Next i
Application.ScreenUpdating = True: Application.Calculation = xlCalculationAutomatic
MsgBox "Ready..."
End Sub
Function makeSheetsArray(arr, wb As Workbook) As Variant 'it makes an array of all selected sheets (split x-y cases)
Dim arrFin, arr_, k As Long, i As Long, j As Long
ReDim arrFin(wb.Sheets.count) 'maximum possible number of sheets
For i = 0 To UBound(arr)
If InStr(arr(i), "-") > 0 Then 'for the case of x-y:
arr_ = Application.Evaluate("ROW(" & Replace(arr(i), "-", ":") & ")") ' 2D array base 1
For j = 1 To UBound(arr_)
arrFin(k) = arr_(j, 1): k = k + 1
Next j
Else
arrFin(k) = arr(i): k = k + 1
End If
Next i
ReDim Preserve arrFin(k - 1)
makeSheetsArray = arrFin
End Function
Please, send some feedback after testing it.
If something not clear enough, do not hesitate to ask for clarifications...
I would like to solve the following problem:
In Worksheet1 I have a range in text form from O3 to O4500. If the cells in this range contain certain words, I want an "x" to be put in the range U3:U4500 (in the same row). The words to be tested are in range B4:B15 in another Worksheet (Worksheet2).
I made it work with the following code (solution1), but now I don't want to type the code manually for word1, word2, words3... instead it should be taken from the other range in Worksheet 2 (see my draft below in solution2). I believe the problem are the "* *" which are missing when I use the referral to the other range.
Any help is very much appreciated!
Sub solution1()
Dim i As Long
For i = 3 To 4500
If LCase$(Worksheet1.Range("O" & i).Value) Like "*word1*" Or _
LCase$(Worksheet1.Range("O" & i).Value) Like "*word2*" Or _
LCase$(Worksheet1.Range("O" & i).Value) Like "*word3*" Then
Worksheet1.Range("U" & i).Value = "x"
End If
Next
End Sub
Sub solution2()
Dim i As Long, c As Long
For i = 3 To 4500
For c = 4 To 15
If LCase$(Worksheet1.Range("O" & i).Value) Like LCase$(Worksheet2.Range("B" & c).Value) Then
Worksheet1.Range("U" & i).Value = "x"
End If
Next
Next
End Sub
try something like:
Sub solution2()
Dim i As Long, c As Long
searchstring = LCase$(Worksheets("Worksheet2").Range("B1").Value & "|" & Worksheets("Worksheet2").Range("B2").Value & "|" & Worksheets("Worksheet2").Range("B3").Value)
For i = 2 To 9
If Len(LCase$(Worksheets("Worksheet1").Range("O" & i).Value)) < 1 Then GoTo neexxtt
'line above prevents empty lines to be marked
If InStr(searchstring, LCase$(Worksheets("Worksheet1").Range("O" & i).Value)) <> 0 Then Worksheets("Worksheet1").Range("U" & i).Value = "x"
neexxtt:
Next
End Sub
A VBA Lookup: Using an (Array)Formula For Partial Matches
In Excel, in cell U3, you could use the following array formula:
=IF(COUNT(MATCH("*"&Sheet2!$B$4:$B$15&"*",O3,0))>0,"X","")
and copy it down (adjust the lookup worksheet name (Sheet2)).
The following solution is based on this formula avoiding any loops.
Sub VBALookup()
Const Flag As String = "x"
' Reference the ranges.
Dim srg As Range ' Source
Dim drg As Range ' Destination
Dim lrg As Range ' Lookup
With Worksheet1
Set srg = .Range("O3", .Cells(.Rows.Count, "O").End(xlUp))
Set drg = srg.EntireRow.Columns("U")
End With
With Worksheet2
Set lrg = .Range("B4", .Cells(.Rows.Count, "B").End(xlUp))
End With
' Build the array formula.
Dim ArrayFormula As String
ArrayFormula = "=IF(COUNT(MATCH(""*""&'" & Worksheet2.Name & "'!" _
& lrg.Address & "&""*""," & srg.Cells(1).Address(0, 0) & ",0))>0,""" _
& Flag & ""","""")"
' Write the formulae (values).
With drg
' Write the array formula to the first cell.
.Cells(1).FormulaArray = ArrayFormula
' Autofill to the bottom.
.Cells(1).AutoFill .Cells, xlFillDefault
' Not sure, but instead of the previous 2 lines, in Office 365,
' the following single line should work:
'.Cells.Formula = ArrayFormula
' Convert to values (out-comment if you want to keep the formulae).
.Value = .Value
End With
End Sub
I would like to auto-populate new sheets in Excel with their names based on the cell value. However, it won't be the value from one cell but from the list of cells in the row. The name of the first worksheet will be fetched from the 1st cell value, the name of the second worksheet from the 2nd cell value, and so on...
I defined the maximum range of these cells - 20 in the row, but not all of them will have the values. I want the new sheets to be created only from these cells, where value is provided.
I used the following code:
Sub Namedsheetsadding()
Dim wsr As Worksheet, wso As Worksheet
Dim i As Long, xCount As Long
Dim SheetName As String
Set wsr = ThisWorkbook.Sheets("Vetro Area Map 1")
SheetName = ThisWorkbook.Sheets("Frontsheet").Range("D122:D142") 'including empty cells either, but
not creating new sheets for them
For i = 1 To ActiveWorkbook.Sheets.Count
If InStr(1, Sheets(i).name, "Vetro") > 0 Then xCount = xCount + 1
Next
wsr.Copy After:=ActiveWorkbook.Sheets(wsr.Index - 1 + xCount)
ActiveSheet.name = "Vetro Area Map " & SheetName & xCount + 1
End Sub
Based on some solutions here:
VBA rename sheet based on cell value
http://excelexperts.com/vba-code-adding-new-sheet-based-cell-value
https://www.mrexcel.com/board/threads/vba-create-new-sheet-based-on-cell-data.740895
EXCEL VBA Dynamic Sheet Name according to a cell value - Not working when formula in the cell
which apply to one cell only
Possibly this is the reason, why I am getting:
Error: Type mismatch
for the following line:
SheetName = ThisWorkbook.Sheets("Frontsheet").Range("D122:D142") 'including empty cells either, but not creating new sheets for them
Is there any chance to make the sheet auto-population with names based on the cell range?
This should do what you are looking for,it gets an array from the range, converts it into a 1d array and then makes the sheets.
Sub Namedsheetsadding()
Dim wsr As Worksheet, wso As Worksheet
Dim i As Long, xCount As Long
Dim SheetNames As Variant 'This needs to be variant
Dim sheetname As Variant
Dim newsheet As Worksheet
Dim lr As Long
Set wsr = ThisWorkbook.Sheets("Vetro Area Map 1")
lr = ThisWorkbook.Sheets("Frontsheet").Cells(Rows.Count, 4).End(xlUp).Row 'Get last row
SheetNames = ThisWorkbook.Sheets("Frontsheet").Range("D122:D" & lr) 'including empty cells either, but not creating new sheets for them
SheetNames = Application.Transpose(Application.Index(SheetNames, , 1)) 'Converts the 2d array into a 1d array
For i = 1 To ActiveWorkbook.Sheets.Count
If InStr(1, Sheets(i).Name, "Vetro") > 0 Then xCount = xCount + 1
Next
For Each sheetname In SheetNames
wsr.Copy After:=ActiveWorkbook.Sheets(wsr.Index - 1 + xCount)
Set newsheet = Sheets(wsr.Index + xCount)
newsheet.Name = "Vetro Area Map " & sheetname
xCount = xCount + 1 'Preserve order of sheets from range
Next
End Sub
In answer to your question, YES, you can make sheets automatically named, but you'll need to handle your rules better. You're getting an error because you're trying to reference an array to a single string. I would recommend learning about arrays (Paul Kelly has some great stuff here), but there might be other ways to approach your specific issue.
If you're more familiar with Excel than VBA, you should try to make a cell formula rule that populates a SINGLE cell that should be the next name of a worksheet. If you can have a cell that will always have the proper name, then you can always have your code reference the same value.
Alternatively, you might want to use the VBA offset function, which is pretty easier for newer coders to comprehend.
See below as an example.
Sub makeNewWorksheets()
Dim wsr As Worksheet, wso As Worksheet
Dim i As Long, xCount As Long
Dim SheetName As String
Dim startTingCell As Range
Set startTingCell = Range("D122")
For i = 1 To ActiveWorkbook.Sheets.Count
If InStr(1, Sheets(i).Name, "Vetro") > 0 Then xCount = xCount + 1
Next
'Changes the cell being referenced by xCount
Set startTingCell = startTingCell.Offset(xCount, 0)
'helps explain what is happening. Delete after you've grasped what's up.
MsgBox "The cell that will be set to the name is " & startTingCell.Address & _
"with a value of " & startTingCell.Value
wsr.Copy After:=ActiveWorkbook.Sheets(wsr.Index - 1 + xCount)
ActiveSheet.Name = "Vetro Area Map " & startTingCell.Value
End Sub
We have a workbook that needed to have the sheets change names every month and I decided to automate it for other employees. So after some research I found the best way to do it was to reference the names of cells. I needed it to start running on the 4th sheet and run through the second last sheet. I found some VBA code and edited it until I got to this point:
Sub RenameSheet()
Dim ShCnt As Integer 'count of sheets in workbook
Dim myarray() As String 'array of new worksheet names
Dim Month() As String 'mystery variable -- not used in this code
Dim i As Integer 'loop counter
Dim Lrow As Integer 'number of new worksheet names.
ThisWorkbook.Sheets("SETUP").Select 'select the sheet that has the list of new names
Lrow = Range("T1").End(xlDown).Row 'get range that contains new worksheet names
ShCnt = ThisWorkbook.Sheets.Count 'get number of worksheets in the workbook
ReDim myarray(1 To Lrow) 'resize array to match the number of new worksheet names
For i = 1 To UBound(myarray) 'loop through array of new sheet names
myarray(i) = Range("T" & i).Value 'insert new sheet name into array
Debug.Print Range("T" & i).Value 'show the new worksheet name in 'the Immediate window to be able to check that we're getting what we want
Next i 'end of loop
For i = 4 To ShCnt - 1 'loop through array of existing worksheets
Sheets(i).Name = myarray(i) 'rename each worksheet with the matching name from myarray
Next i 'end of loop
MsgBox "Sheets name has changed successfully" 'report success
End Sub
My issue is that I need the 4th sheet to start with the value in cell "T2". I have figured out that this section of code changed the starting point:
For i = 1 To UBound(myarray)
myarray(i) = Range("T" & i).Value
Debug.Print Range("T" & i).Value
Next i
When I replaced myarray(i) = Range("T" & i).Value with myarray(i) = Range("T2" & i).Value it started on cell T24 for some reason (which may have to do with the placement of my button?) and myarray(i) = Range("T" + 1 & i).Value doesn't work.
I also tried changing the For i = 1 To UBound(myarray) to For i = 2 To UBound(myarray) and that didn't work either.
Can someone please help me figure out how to get it so that the information in cell T2 ends up on the 4th sheet and goes from there? Thank you very much in advance.
I would suggest loop through worksheets in the workbook and use the loop counter to index into the range of names in column T:
Sub RenameSheet()
Dim ShCnt As Integer
Dim i As Integer
Dim ws_setup As Worksheet
Set ws_setup = ThisWorkbook.Worksheets("SETUP")
ShCnt = ThisWorkbook.Worksheets.Count
Const start_ws_index = 4
For i = start_ws_index To ShCnt - 1
ThisWorkbook.Worksheets(i).Name = _
ws_setup.Range("t2").Offset(i - start_ws_index, 0).Value
Next i
End Sub
Rename Sheets From List
In the current setup, it is assumed that the list is contiguous (no blanks), has at least two entries, and starts in cell T2, and that the 4th sheet is the first to be renamed.
The Code
Option Explicit
Sub renameSheets()
' Constants
Const wsName As String = "SETUP"
Const FirstCell As String = "T2"
Const FirstSheetIndex As Long = 4
' Workbook
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
' Array (at least two names)
Dim SheetNames As Variant
With wb.Worksheets(wsName)
SheetNames = .Range(FirstCell, .Range(FirstCell).End(xlDown))
End With
' Rename
Dim shOffset As Long: shOffset = FirstSheetIndex - 1
Dim i As Long
For i = 1 To UBound(SheetNames, 1)
wb.Sheets(i + shOffset).Name = SheetNames(i, 1)
Next i
' Inform
MsgBox "Sheet names changed successfully", vbInformation
End Sub
I am trying to print a few months worth of time sheets. So print 20 copies of the same sheet, and change the date on one cell (cell "C1" on "Timesheets" sheet) using a list of fortnightly dates on the "Pay Periods" sheet.
Have tried multiple methods but can't get close for varying reasons...
Would be interested to learn why am getting errors or stuck on each method I have tried below.
Sub PrintAllDates()
Dim printDate As Date
Dim startDate As Date
Dim endDate As Date
startDate = Worksheets("Pay Periods").Range("A2")
endDate = Worksheets("Pay Periods").Range("A10")
For printDate = startDate To endDate
Sheets("Timesheet").Range("C1") = printDate
Sheets("Timesheet").PrintOut
Next
This works but I can't figure out how to get it to use the list.
It prints out 9 consecutive days instead, whereas my list is 9 consecutive "fortnights".
Sub PrintCopies()
Dim i As Integer
Dim VList As Variant
VList = Sheets("Pay Periods").Range("H2:H3").Value
For i = LBound(VList) To UBound(VList)
Range("C1") = VList(i)
ActiveSheet.PrintOut
Next
With the above, I get runtime error 9 "Subscript out of range" on Range("C1") = VList(i)
Sub PrintCopies()
Dim i As Date
Dim VList As Variant
VList = Array(Worksheets("Pay Periods").Range("A2:A10"))
For i = LBound(VList) To UBound(VList)
Sheets("Timesheet").Range("C1") = VList(i)
Sheets("Timesheet").PrintOut
Next
This also works, but only 1 page gets printed out.
Date also gets converted to "13 Jan 1900".
The first code does not work because it is not considering the whole range of dates; instead it takes only the value inside the first and last cell, treating them as dates. The code basically takes those dates and covers each day between them. It does not even akwnoledge the others cells between A2 and A10. This one should work:
Sub PrintAllDates()
'Declaring variables.
Dim RngDate As Range
Dim RngDates As Range
Dim RngTarget As Range
'Setting variables.
Set RngDates = Sheets("Pay Periods").Range("A2:A10")
Set RngTarget = Sheets("Timesheet").Range("C1")
'Covering each cell in RngDates.
For Each RngDate In RngDates
'Changing RngTarget.
RngTarget = RngDate.Value
'Printing RngTarget's sheet.
RngTarget.Parent.PrintOut
Next
End Sub
I've also added a feature to check if the given value is a date in this version:
Sub PrintAllDates()
'Declaring variables.
Dim RngDate As Range
Dim RngDates As Range
Dim RngTarget As Range
'Setting variables.
Set RngDates = Sheets("Pay Periods").Range("A2:A10")
Set RngTarget = Sheets("Timesheet").Range("C1")
'Covering each cell in RngDates.
For Each RngDate In RngDates
'Checking if RngDate does not contain a date value.
If Not VBA.Information.IsDate(RngDate.Value) Then
'Asking what to do in case RngDate does not contain a date value.
Select Case MsgBox("Range " & RngDate.Address(False, False) & " in sheet " & RngDate.Parent.Name & " contains the value """ & RngDate.Value & """, which is a non-date value." & vbCrLf & _
vbCrLf & _
vbCrLf & _
"Do you wish to use it and print anyway?" & vbCrLf & _
vbCrLf & _
"Press ""Yes"" to print it anyway." & vbCrLf & _
vbCrLf & _
"Press ""No"" to not print it and proceed to the next value." & vbCrLf & _
vbCrLf & _
"Press ""Cancel"" to stop the macro and print no more.", _
vbYesNoCancel, _
"Non-date value detected" _
)
'If "Cancel" is pressed, the macro is terminated.
Case Is = 2
Exit Sub
'If "Yes" is pressed, the macro goes on.
Case Is = 6
'If "No" is pressed, the macro goes to NextRngDate
Case Is = 7
GoTo NextRngDate
End Select
End If
'Changing RngTarget.
RngTarget = RngDate.Value
'Printing RngTarget's sheet.
RngTarget.Parent.PrintOut
'Checkpoint.
NextRngDate:
Next
End Sub
Your code can be something like this:
Sub PrintAllDates()
Dim listRange As Range ' Your range A2:A10 in "Pay Periods" sheet '
Dim oCurrentCell As Range ' Single cell from this range '
Dim printedSheet As Worksheet ' Target sheet - "Timesheet" '
Dim oTargetCell As Range ' C1 - target cell (to set next date from list) '
Set listRange = Worksheets("Pay Periods").Range("A2:A10")
Set printedSheet = Worksheets("Timesheet")
Set oTargetCell = printedSheet.Range("C1")
For Each oCurrentCell In listRange.Cells
oTargetCell = oCurrentCell
Rem If some cells in "Timesheet" has formulas which reffered to C1,
Rem we need recalc it before printing
printedSheet.Calculate
printedSheet.PrintOut
Next oCurrentCell
End Sub