I have many sheets(about 1000) with names as integer number like: 1 2 3 5 7 10 etc. They are ascending but not consistent, like I wrote.
I have vba code that create new sheet with numbername from inputbox, after the activesheet(I activate sheet 3, run the code, enter 4 in inputbox and it creates sheet 4 after 3). What I need is solution how to (example): create a new sheet with name 4 after the sheetnumber 3, without haveing to be on sheet 3.
The following code with go through all the sheets. When it reaches one with a larger number it will insert the new sheet before it.
Public Sub Test()
AddSheetWithNumber shNum:=4
End Sub
Public Sub AddSheetWithNumber(shNum As Long)
With ThisWorkbook
Dim sh As Worksheet
For Each sh In Worksheets
' Find first sheet with number greater than new sheet number
If CLng(sh.Name) > shNum Then
' Add worksheet before sheet with larger number
.Worksheets.Add before:=sh
ActiveSheet.Name = CStr(shNum)
Exit For
End If
Next
End With
End Sub
I came up with similar solution before I saw your example Paul. It might be usefull as well:
Sub New_Sheet()
Dim ExistingSheet As Integer
Dim NewSheet As Integer
On Error GoTo 30
NewSheet = InputBox("Enter new sheet:", "NEW SHEET")
For i = 3 To Sheets.Count - 3 'this is my work range
ExistingSheet = Sheets(i).Name
If ExistingSheet = NewSheet Then
MsgBox ("That sheet already exist!")
Sheets(i).Activate
GoTo 30
Else
On Error GoTo 10 'last 4 sheets have textual name like (subtotal, partners, etc) so error came up if I want to add sheet with bigest number(because it's comparing a textual name)
If NewSheet > ExistingSheet Then 'error came up only in that case for now, so I make it place biggest sheet before textual one.
GoTo 20
Else
ActiveWorkbook.Sheets("Empty Card").Copy _
after:=Sheets(i - 1) 'Sheet with formulas and tables prepared for work
ActiveSheet.Name = NewSheet
ActiveSheet.Cells(2, 13) = ActiveSheet.Name
Exit Sub
End If
End If
20 Next i
10 ActiveWorkbook.Sheets("Empty card").Copy _
after:=Sheets(i - 1) 'didn't know of "befor" command
ActiveSheet.Name = NewSheet
ActiveSheet.Cells(2, 13) = ActiveSheet.Name
30 Exit Sub
End Sub
Related
I am pretty new to this website, so do bear with me.
My question:
Let say I need to copy cells A2:X16 from Sheet 1 and paste it to Sheet 2 15 times then cells A17:X31 from Sheet 1 to Sheet 2 15 times, right below the one I had copied previously.
Sub etest()
Dim Rng as range
If IsNumeric(Range("BX3")) = True Then
MsgBox "Success!"
Set Rng = Range("A2:X16")
Rng.Copy Rng.Offset(15).Resize(Range("BW3") * Rng.Rows.Count)
Else
MsgBox "please enter a valid number."
End If
Application.CutCopyMode = False
End Sub
Your code doesn't copy anything or set a cell value equal to another cell value (both ways are used to move the contents from one cell to another).
This code uses a couple of simple loops to copy two static ranges from Sheet1 to dynamic ranges in Sheet2.
The code uses ThisWorkbook which is a reference to the workbook containing the code. You could also use ActiveWorkBook or Workbooks("MyNamed_WorkedBook") depending on your needs.
Sub Test()
Dim lRow As Long
For lRow = 0 To 14
ThisWorkbook.Worksheets("Sheet1").Range("A2:X16").Copy _
Destination:=ThisWorkbook.Worksheets("Sheet2").Cells(lRow * 15 + 2, 1)
Next lRow
For lRow = 15 To 29
ThisWorkbook.Worksheets("Sheet1").Range("A17:X31").Copy _
Destination:=ThisWorkbook.Worksheets("Sheet2").Cells(lRow * 15 + 2, 1)
Next lRow
End Sub
I'm new in Excel VBA. I want to insert number of cells based on a cell value.
I have sheet1, i want to use b4 as a reference as to the number of sheets (which is a template) to be inserted.
Example, if value of b4 = 4, I'd like to copy the template sheet 4 times.
How do i do that in vba?
THANKS. :)
No magic, create them one by one in a loop, place each new one at the end. Edit: You want also to rename them 1, 2, 3, 4,.. so:
Sub CreateSheets()
Dim i As Long
With ThisWorkbook.Sheets
For i = 1 To Sheet1.Range("B4").Value2
.Item("Template").Copy After:=.Item(.Count)
.Item(.Count).Name = i
Next
End With
End Sub
Or something like this...
Sub CopyTemplate()
Dim ws As Worksheet, wsTemplate As Worksheet
Dim n As Integer, i As Long
Application.ScreenUpdating = False
Set ws = Sheets("Sheet1")
Set wsTemplate = Sheets("Template") 'Where Template is the name of Template Sheet, change it as required.
n = ws.Range("B4").Value
If n > 0 Then
For i = 1 To n
wsTemplate.Copy after:=Sheets(Sheets.Count)
ActiveSheet.Name = i
Next i
End If
Application.ScreenUpdating = True
End Sub
Something like this should work:
Sub copySheets()
Dim i As integer
Dim n As integer 'the amount of sheets
n = Cells(4, 2).Value 'b4
For i = 2 To n
If ActiveWorkbooks.Worksheets.Count < n Then 'Makes sure the sheets exists
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets.Add(After:= _
ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
End If
ws1.Copy ThisWorkbook.Sheets(Sheets.Count) 'copy data
Next i
End Sub
my VBA code is copy/pasting rows from several sheets in the workbook into another sheet based on a specific input criteria. It uses an InStr search to find the input criteria on sheets starting with "E" in column D between rows 17-50 - which is working good.
However, when activiting the sub through a button it only copy/pasts the first entry it finds and jumps to the next worksheet. In debug.mode it finds all entries in one worksheet, does copy/paste and only then jumps to the next worksheet.
What do I need to change?
Sub request_task_list()
Dim rPlacementCell As Range
Dim myValue As Variant
Dim i As Integer, icount As Integer
myValue = InputBox("Please enter the Name (Name or Surname) of the Person whos task you are looking for", "Input", "Hansen")
If myValue = "" Then
Exit Sub
Else
Set rPlacementCell = Worksheets("Collect_tool").Range("A3")
For Each Worksheet In ActiveWorkbook.Worksheets
'Only process if the sheet name starts with 'E'
If Left(Worksheet.Name, 1) = "E" Then
Worksheet.Select
For i = 17 To 50
If InStr(1, LCase(Range("D" & i)), LCase(myValue)) <> 0 Then
'In string search for input value from msg. box
'Copy the whole row if found to placement cell
icount = icount + 1
Rows(i).EntireRow.Copy
rPlacementCell.PasteSpecial xlPasteValuesAndNumberFormats
Range("D2").Copy
rPlacementCell.PasteSpecial xlPasteValues
Set rPlacementCell = rPlacementCell.Offset(1)
End If
Next i
End If
Next Worksheet
Worksheets("collect_tool").Activate
Range("B3").Activate
End If
End Sub
This code works for me:
Sub request_task_list()
Dim rPlacementCell As Range
Dim myValue As Variant
Dim i As Integer
Dim wrkBk As Workbook
Dim wrkSht As Worksheet
Set wrkBk = ActiveWorkbook
'or
'Set wrkBk = ThisWorkbook
'or
'Set wrkBk = Workbooks.Open("C:/abc/def/hij.xlsx")
myValue = InputBox("Please enter the Name (Name or Surname) of the Person whos task you are looking for", "Input", "Hansen")
If myValue <> "" Then
Set rPlacementCell = wrkBk.Worksheets("Collect_tool").Range("A3") 'Be specific about which workbook the sheet is in.
For Each wrkSht In wrkBk.Worksheets
'Only process if the sheet name starts with 'E'
If Left(wrkSht.Name, 1) = "E" Then
For i = 17 To 50
'Cells(i,4) is the same as Range("D" & i) - easier to work with numbers than letters in code.
If InStr(1, LCase(wrkSht.Cells(i, 4)), LCase(myValue)) > 0 Then 'Be specific about which sheet the range is on.
'In string search for input value from msg. box
'Copy the whole row if found to placement cell
wrkSht.Rows(i).EntireRow.Copy
rPlacementCell.PasteSpecial xlPasteValuesAndNumberFormats
rPlacementCell.Value = wrkSht.Cells(2, 4).Value
Set rPlacementCell = rPlacementCell.Offset(1)
End If
Next i
End If
Next wrkSht
Worksheets("collect_tool").Activate
Range("B3").Activate
End If
End Sub
I'm guessing your code failed at this point: For Each Worksheet In ActiveWorkbook.Worksheets. Worksheet is a member of the Worksheets collection and I don't think it can be used this way. Note in my code I've set wrkSht as a Worksheet object and then used wrkSht to reference the current worksheet in the loop.
I am trying to build a macro that loops through a range of values within colA and check if they exist with another workbook. In one of them I would like to mark it "Worked"/"Not Worked"
Any guidance on where to start?
Example
Here is an example of what you're looking for. Remember that both the workbooks have to be opened in the same instance of Excel.
Sub check()
Dim i As Integer, k As Integer, j As Integer 'Define your counting variables
Dim Report1 As Worksheet, bReport As Workbook, Report2 As Worksheet, bReport2 As Workbook 'Define your workbook/worksheet variables
Set Report1 = Excel.ActiveSheet 'Assign active worksheet to report1
Set bReport = Report1.Parent 'Assign the workbook of report 1 to breport
On Error GoTo wbNotOpen 'If an error occurs while accessing the named workbook, send to the "wbNotOpen" line.
Set bReport2 = Excel.Workbooks("otherworkbookname.xlsm") 'Assign the other workbook which you are cross-referencing to the bReport2 variable.
Set Report2 = bReport2.Worksheets("otherworksheetname") 'Do the same with the worksheet.
On Error GoTo 0 'Reset the error handler (to undo the wbNotOpen line.)
k = Report1.UsedRange.Rows.Count 'Get the last used row of the first worksheet.
j = Report2.UsedRange.Rows.Count 'Get the last used row of the second worksheet.
For i = 2 To k 'Loop through the used rows of the first worksheet. I started at "2" to omit the header.
'Next, I used the worksheet function "countIf" to quickly check if the value exists in the given range. This way we don't have to loop through the second worksheet each time.
If Application.WorksheetFunction.CountIf(Report2.Range(Report2.Cells(2, 1), Report2.Cells(j, 1)), Report1.Cells(i, 1).Value) > 0 Then
Report1.Cells(i, 5).Value = "Worked" 'If the value was found, enter "Worked" into column 5.
Else
Report1.Cells(i, 5).Value = "Not worked" 'If the value wasn't found, enter "Not worked" into column 5.
End If
Next i
Exit Sub
'This is triggered in the event of an error while access the "other workbook".
wbNotOpen:
MsgBox ("Workbook not open. Please open all workbooks then try again.")
Exit Sub
End Sub
This link also includes steps that tell how to check if a cell exists in another workbook. The comments are useful.
Excel macro - paste only non empty cells from one sheet to another (Stack Overflow)
Thanks to #Lopsided's solution, I have tweeked his code to bring forth this solution. And this seems to work.
{
Sub CheckValue()
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim i As Integer
Dim k As Integer
Dim j As Integer
Set S1 = Worksheets("Sheet1")
Set S2 = Worksheets("Sheet2")
k = S1.UsedRange.Rows.Count
j = S2.UsedRange.Rows.Count
For i = 1 To k
If Application.WorksheetFunction.CountIf(S2.Range(S2.Cells(2, 1), S2.Cells(j, 1)), S1.Cells(i, 1).Value) > 0 Then
S1.Cells(i, 5).Value = "Worked" 'If the value was found, enter "Worked" into column 5.
Else
S1.Cells(i, 5).Value = "Not worked" 'If the value wasn't found, enter "Not worked" into column 5.
End If
Next i
End Sub
}
I'm trying to write a vba macro for a group tha
has one workbook where they daily create new worksheets, and also have
Sheet 1, Sheet 2 and Sheet 3 at the end of their long list of sheets.
I need to create a external cell reference in a new column in a different workbook where this information is being summarized.
So I need to know how to get the last non-empty sheet so I can grab this data and place it appropriately in the summary.
This function works through the sheets from right to left until it finds a non-blank sheet, and returns its name
Function GetLastNonEmptySheetName() As String
Dim i As Long
For i = Worksheets.Count To 1 Step -1
If Sheets(i).UsedRange.Cells.Count > 1 Then
GetLastNonEmptySheetName = Sheets(i).Name
Exit Function
End If
Next i
End Function
The method above will ignore a sheet with a single cell entry, while that may seem to be a quibble, a Find looking for a non-blank cell will give more certainty.
The xlFormulas argument in the Find method will find hidden cells (but not filtered cells) whereas xlValues won't.
Sub FindLastSht()
Dim lngCnt As Long
Dim rng1 As Range
Dim strSht As String
With ActiveWorkbook
For lngCnt = .Worksheets.Count To 1 Step -1
Set rng1 = .Sheets(lngCnt).Cells.Find("*", , xlFormulas)
If Not rng1 Is Nothing Then
strSht = .Sheets(lngCnt).Name
Exit For
End If
Next lngCnt
If Len(strSht) > 0 Then
MsgBox "Last used sheet in " & .Name & " is " & strSht
Else
MsgBox "No data is contained in " & .Name
End If
End With
End Sub