I have a range of cell numbers that I need for multiple worksheet names.
I create multiple worksheets based on the number of rows.
Sub Copier()
Dim x As Integer
x = InputBox("Enter number of times to copy worksheet")
For numtimes = 1 To x
ActiveWorkbook.Sheets("OMRS 207").Copy _
After:=ActiveWorkbook.Sheets("OMRS 207")
Next
End Sub
That grabs only one name, OMRS 207.
I want to generate these worksheets using the entire range of cells in the original worksheet.
Try below code.
Dim data As Worksheet
Dim rng As Range
Set data = ThisWorkbook.Sheets("Sheet1")
Set rng = data.Range("A2")
Do While rng <> ""
ThisWorkbook.Worksheets.Add
ActiveSheet.Name = rng.Value
Set rng = rng.Offset(1, 0)
Loop
I assumed that your data starts from 2nd row in Sheet1 and you want the sheet name as per values in Column A.
If you want row number as sheet name for newly added sheet just use rng.row while assigning name to sheet.
Related
I have two Excel workbooks.
First Workbook has two sheets: "Sales" and "Lookup".
Second Workbook has one sheet: "ID"
From the first workbook (Sales), I have to read column 'B' values, search it in column A of "Lookup" sheet and get name from column B.
After fetching ID, I have to write to column E of "ID" workbook.
I tried the first part, but it is not iterating through the cells of Sales and not picking value from "Lookup".
Sub btnExport_Click()
Dim rng As Range
Dim ws1, ws2 As Worksheet
Dim MyStringVar1 As String
Set ws1 = ThisWorkbook.Sheets("Lookup")
Set ws2 = ThisWorkbook.Sheets("Sales")
Set rng = ws2.Range("B2")
With ws2
On Error Resume Next 'add this because if value is not found, vlookup fails
MyStringVar1 = Application.WorksheetFunction.VLookup(Left(rng, 6), ws1.Range("A2:C65536").Value, 2, False)
On Error GoTo 0
If MyStringVar1 = "" Then MsgBox "Item not found" Else MsgBox MyStringVar1
End With
End Sub
*** Edited ***
Code fixed. It is now reading from first cell of Sales but not iterating. Also, while iterating and fetching from Lookup, it has to write to another workbook. This I am not able to fix.
There are two changes that you should make to start. First, try not to reference ActiveSheet (as mentioned in the comments). If the macro is run while a different sheet is selected, then it will mess things up. Store the appropriate worksheet in a variable, such as:
Dim ws As Worksheet
Set ws = Sheets("Sales")
The other item that stands out is in your loop, you are using the .Cells off of the rng object. In your case, you set rng to be the used range in Column B. Let's assume that's cells B2:B10. When you then say rng.Cells(i, 2), if actually offset to the second column of the range, which starts with Column B. You end up using column C.
Instead, try something like
Sub btnExport_Click()
Dim rng As Range
Dim i As Long
Dim ws As Worksheet
Set ws = Sheets("sales")
With ws
Set rng = .Range("B2:B" & .Cells(.Rows.Count, 1).End(xlUp).Row)
For i = 2 To rng.Rows.Count
.Cells(i, 2) = Application.WorksheetFunction.VLookup(.Cells(i, 1), Sheets("Lookup").Range("A:B"), 2, False)
MsgBox (.Cells(i, 2))
Next
End With
End Sub
I'm a little stuck at the moment on the problem - I have a workaround but it's very inefficient and also very time consuming to code.
I have a selection of worksheets and I would like to add a different header row to each of these sheets based on the sheet name.
I would like to have a worksheet containing a selection of header rows - see Selection of Header Rows
Then, for example, if the worksheets = A00 - apply the copy in the corresponding Header Row from the Selection worksheet.
This is my current solution - as you can see it is very inefficient and time-consuming
For Each myWorksheet In Worksheets
If myWorksheet.Name = "A00" Then
Sheets("A00").Cells(1).Resize(1, 5).Value = Array("ORGANISATION_ID", "FILE_TYPE", "CREATION_DATE", "CREATION_TIME", "GENERATION_NUMBER")
End If
If myWorksheet.Name = "Z99" Then
Sheets("Z99").Cells(1).Resize(1, 1).Value = Array("RECORD_COUNT")
End If
If myWorksheet.Name = "I56" Then
Sheets("I56").Cells(1).Resize(1, 26).Value = Array("ORGANISATION_SHORT_CODE", "INVOICE_NUMBER", "INVOICE_TYPE_CODE", "BILLING_YEAR", "BILLING_MONTH", "INVOICE_AMOUNT", "INVOICE_VAT_AMOUNT", "INVOICE_GROSS_TOTAL", "PAYMENT_DUE_DATE", "VAT_CHARGED_TO_NWO", "VAT_CHARGED_TO_SHIPPER", "INVOICE_TAX_POINT_DATE", "NWO_VAT_ REGISTRATION_NUMBER", "NWO_BANK_SORT_CODE", "NWO_BANK_ACCOUNT_NUMBER", "NWO_BANK_ACCOUNT_NAME", "ISH_VAT_REGISTRATION_NUMBER", "ISH_BANK_ACCOUNT_NUMBER", "ISH_BANK_SORT_CODE", "NWO_SHORT_CODE", "NWO_VAT_REGISTRATION_NAME", "NWO_ADDRESS_LINE_1", "NWO_ADDRESS_LINE_2", "NWO_ADDRESS_LINE_3", "NWO_ADDRESS_LINE_4", "FILE_NAME")
End If
If myWorksheet.Name = "I05" Then
Sheets("I05").Cells(1).Resize(1, 2).Value = Array("ISC_LINE_1_TEXT", "ISC_LINE_2_TEXT")
End If
If myWorksheet.Name = "I57" Then
Sheets("I57").Cells(1).Resize(1, 8).Value = Array("INVOICE_ITEM_REFERENCE_NUMBER", "INCURRED_DATE", "CHARGE TYPE CODE", "QUANTITY", "UNIT_TYPE", "RATE", "INVOICE_ITEM_AMOUNT", "ANCILLARY_INVOICE_COMMENTS")
End If
If myWorksheet.Name = "K12" Then
Sheets("K12").Cells(1).Resize(1, 4).Value = Array("GAS_ACT_OWNER", "CURRENT_METER_ASSET_MANAGER", "PROSPECTIVE_METER_ASSET_MANAGER", "PROSPECTIVE_MAM_EFFECTIVE_DATE")
End If
Next myWorksheet
Any help with this would be much appreciated.
Create a worksheet called Index and populate it as you have done in the image.
Then, the following code will work through each tab and if the tab name is found in column A it will copy the entire row below that cell into the first row of the tab.
For Each myworksheet In Worksheets
rowfound = Application.Match(myworksheet.Name, Worksheets("Index").Range("A:A"), 0)
If Not (IsError(rowfound)) Then myworksheet.Range("1:1").Value = Worksheets("index").Cells(rowfound + 1, 1).EntireRow.Value
Next
I think I would approach this by doing the steps listed below, with the following assumptions about your worksheets.
The worksheet in your image is named "Selection of Header Rows".
The worksheet in your image will have empty rows between the header
listings as pictured.
The first column pictured in your image is
Column A.
You want the headers to start in Cell A1 of the individual
sheets.
Steps
Define a range of the pictured worksheet in which we'll search for each worksheet's name.
Loop through each worksheet in the collection, finding its name in our search range.
If the name is found, define a range by using the CurrentRegion property of the range in which the name was found. (The current region is a range bounded by any combination of blank rows and blank columns.)
Count the columns in that range.
Offset that range down one row (to exclude the sheet name itself).
Resize that range to be one row "high" and the same number of columns "wide".
Set the header range on the target sheet to be the cell A1 and resize it to have the correct number of columns.
Set the value of that header range equal to the value of the range we built on the "Selection of Header Rows" worksheet.
Dim myWorksheet As Worksheet
Dim searchRange As Range
Set searchRange = Worksheets("Selection of Header Rows").Range("A:A")
Dim foundRange As Range
Dim headerRange As Range
For Each myWorksheet In Worksheets
Set foundRange = searchRange.Find(What:=myWorksheet.Name, LookAt:=xlWhole)
If Not foundRange Is Nothing Then
Set headerRange = foundRange.CurrentRegion.Offset(1, 0)
Dim headerColumnCount As Long
headerColumnCount = headerRange.Columns.Count
Set headerRange = headerRange.Resize(1, headerColumnCount)
myWorksheet.Range("A1").Resize(1, headerColumnCount).value = headerRange.value
End If
Next myWorksheet
I want to create a loop that copies one range to another, dependent on the value in a list. The list contains the names of all the ranges that I want to copy.
So in this example, PolicyOutput is a named range from DD15:DD77. I want it to update with values from another range, policy1, then loop to copy new values again from a different cell range, policy2.
The list of policies is in a range of cells called PolicyChoice
Each row of PolicyChoice contains a reference to a group of cells. It will be values: policy1, policy2, policy3 etc.
The values of the cells refer to named ranges. For example policy1 is A15:A77, and policy2 is B15:B77
I want A15:A77 to copy to DD15:DD77, then B15:B77 to copy to DD15:DD77, but in a way that can be updated and rerun as the list of "PolicyChoice" is changed by the user.
I tried the code below, but it just copies "policy1" over again into each cell in the range PolicyOutput, instead of the values in the range policy1
policyChoiceCount = (Sheets("RunModel").Range("policyChoice").Count) - Application.WorksheetFunction.CountIf(Sheets("RunModel").Range("policyChoice"), "")
For h = 1 To PolicyChoiceCount
Sheets(PolicySheetName).Range("PolicyOutput").Value = WorksheetFunction.Index(Sheets("RunModel").Range("policyChoice"), h)
Next h
Thanks!
Add Range(WorksheetFunction ..).value like this
Sheets(policySheetName).Range("PolicyOutput").Value = _
Range(WorksheetFunction.Index(Sheets("RunModel").Range("policyChoice"), h)).Value
or in simple steps
Sub mycopy()
Dim wb As Workbook, wsSource As Worksheet, wsTarget As Worksheet
Dim rngSource As Range, rngTarget As Range, cell As Range
Set wb = ThisWorkbook
Set wsSource = wb.Sheets("RunModel")
Set wsTarget = wb.Sheets("PolicySheetName")
Set rngTarget = wsTarget.Range("PolicyOutput")
For Each cell In wsSource.Range("PolicyChoice")
If Len(cell) > 0 Then
On Error Resume Next
If IsEmpty(Range(cell)) Then
MsgBox "No named range " & cell, vbCritical, "ERROR"
Exit Sub
End If
On Error GoTo 0
rngTarget.Value = Range(cell).Value
End If
Next
End Sub
The workbook has approx 50 spredsheets with a unique name. Each spreadsheet has data till column "F".
I would like to pull the spreadsheet name in one column and max data from column "C" in each spreadsheet to the next column though I know that the max data is from perticular spreadsheet.
How's something like this:
Sub get_Max()
Dim mainWS As Worksheet, ws As Worksheet
Dim rng As Range, cel As Range
Dim i%
Set mainWS = Sheets("Sheet1") ' Change this to meet your criteria. This is where the data will go
For i = Sheets.Count To 0 Step -1
If Worksheets(i).Name = mainWS.Name Then Exit For
' Let's first list the sheet names in Column A of our mainWS
mainWS.Cells(i, 1).Value = Sheets(i).Name
' Then get the max value from column C ('3').
mainWS.Cells(i, 2).Value = WorksheetFunction.Max(Sheets(i).Range(Sheets(i).Columns(3), Sheets(i).Columns(3)))
Next i
End Sub
Using For Each and the Find method, I can look for a cell in a range even if the range is multiple columns by multiple rows. But how can I look for a set of cells in a range?
For example, I have a reference book whose row entries fill rows 2-7 and are two columns wide. I need to find if they have an exact match to the row entries (which also begin in row 2 and are two columns wide) in my target book. If it finds a match, it pastes the row # from the reference file into column 5. Otherwise, it pastes in the new entry. Here's the code so far:
Dim NewFile as Workbook 'defined as the location of the reference book
Dim NewSht as Worksheet 'defined as the sheet in NewFile
Dim ThisSht as Worksheet 'defined as the sheet in the target book
Dim NewName as Range
Dim LastEntry as Range
Dim OldNameRange as Range
Dim EntryMatch as Range
For Each NewName In NewSht.Range(NewSht.Cells(2, 1), NewSht.Cells(Rows.Count, 2).End(xlUp)) 'loops thru each set of entry labels in new sheet
Set LastEntry = ThisSht.Cells(Rows.Count, 2).End(xlUp)
Set OldNameRange = ThisSht.Range(ThisSht.Cells(2, 1), LastEntry)
Set EntryMatch = OldNameRange.Find(NewName.Value, LookIn:=xlValues, lookat:=xlWhole, MatchCase:=True)
If Not EntryMatch Is Nothing Then
ThisSht.Cells(EntryMatch.Row, 5).Value = NewName.Row
Else
ThisSht.Cells(LastEntry.Row + 1, 1).Resize(1, 2).Value = NewSht.Range(NewSht.Cells(NewName.Row, 1), NewName.Cells(NewName.Row, 2)).Value
ThisSht.Cells(LastEntry.Row + 1, 3).Value = NewName.Row
End If
Next
Right now, it's only comparing cell by cell. Can anyone help me get it to compare a set of cells (each row of entries) against each set of cells in the OldNameRange? Thanks!