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
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 wanted to copy all visible rows from sheet1 table1 to sheet2 table2 after filter if Column B is empty. The code I have below only copy the last data to the other sheet and it will copy to the rest of the table.
Sub Send()
Dim i As Integer, j As Integer, k As Integer
Dim wsCopy As Worksheet
Dim wsDest As Worksheet
Dim visRng As Range ' Creating a range variable to store our table, excluding any rows that are filtered out.
Set wsCopy = Application.ThisWorkbook.Worksheets("Sheet1")
Set wsDest1 = Application.ThisWorkbook.Worksheets("Sheet2")
MsgBox "Sending Form...."
Set visRng = Range("Table1").SpecialCells(xlCellTypeVisible) 'Check all visible Rows in Table1
Dim r As Range
For Each r In visRng.Rows ' Loop through each row in our visible range ...
'MsgBox (r.Row) ' ... and retrieve the "absolute" row number.
If wsCopy.Cells(r.Row, 2).Value = "" Then
wsCopy.Range("A" & r.Row).Copy
wsDest1.Range("Table2").Columns(1).PasteSpecial
End If
Next
End Sub
here is sample filter in Sheet1 Table1
here is the result of my code in Sheet2 Table2
Expected Result: Sheet2 Table2
This should work:
Sub Send()
Dim i As Integer, j As Integer, k As Integer
Dim wsCopy As Worksheet
'IN THE CODE wsDest WAS CALLED wsDest1. I CHANGED THE REFERENCES IN THE CODE. I'D SUGGET YOU TO USE Option Explicit.
Dim wsDest As Worksheet
Dim visRng As Range ' Creating a range variable to store our table, excluding any rows that are filtered out.
'ADDED A NEW VARIABLE
Dim DblRow As Double
Set wsCopy = Application.ThisWorkbook.Worksheets("Sheet1")
Set wsDest = Application.ThisWorkbook.Worksheets("Sheet2")
MsgBox "Sending Form...."
'CHANGED visRng TO TARGET ONLY THE FIRST COLUMN OF Table1. NO NEED TO INCLUDE THE REST OF THE TABLE; IT WOULD ONLY MAKE OUR EXECUTION LONGER
Set visRng = Range("Table1").Columns(1).SpecialCells(xlCellTypeVisible) 'Check all visible Rows in Table1
'YOU SHOULD PUT THIS DECLARATION AT THE BEGINNING. ALSO I'D SUGGEST NOT TO USE A SINGLE LETTER VARIABLE. wsDest IS A GOOD NAME FOR A VARIABLE.
Dim r As Range
'SETTING THE VARIABLE.
DblRow = 1
For Each r In visRng.Rows ' Loop through each row in our visible range ...
'MsgBox (r.Row) ' ... and retrieve the "absolute" row number.
If wsCopy.Cells(r.Row, 2).Value = "" Then
wsCopy.Range("A" & r.Row).Copy
'YOUR CODE DIDN'T SCROLL THE TABLE 2. USING DBLROW IN .Cells YOU CAN DO IT.
wsDest.Range("Table2").Cells(DblRow, 1).PasteSpecial
DblRow = DblRow + 1
End If
Next
End Sub
Edits highlighted by proper comments.
Report any question you have or bug you have encountered. If, according to your judgment, this answer (or any other) is the best solution to your problem you have the privilege to accept it (link).
I need help to create an automatic method to copy a row to a specific sheet.
I have a Tab (Sales) with a WEB api query importing data in this sheet every 5 min. I have a row within the Sales sheet with a name range identifying each item. The row has 100 different names and there are 100 sheets created with same names within the workbook.
I want to copy the entire row for each item and copy it to the sheet with the same name of the item.
This is to fire off the copy sub:
'Copy Sales data Every 10 Min
Sub test()
'Application.OnTime Now + TimeValue("00:10:00"), "my_Procedure…"
End Sub
I have seen many methods on how to copy the row automatically, but I need help in copy row and use the item name and paste to other sheet with same name.
Without further information here is an outline of what i described in the comments. Here the list of named ranges starts at cell J3 in NamesSheet. In the image, i have shown it in the same sheet (SourceSheet for simplicity). The list is read into an array and that array is looped to select the appropriate sheet to set the values in.
Rather than copy and paste it sets the target row (the next available row), in the sheet accessed by the array index, equal to the source row (copyRow). A With statement is used to avoid selecting the target sheet (more efficient).
No error handling added for missing sheets at present.
I haven't assumed there will be a list of 100 named ranges in the sheet, otherwise you could have sized the array from the start.
Named ranges in ColA of Sales tab:
List of named ranges in Names sheet (abbreviated)
Option Explicit
Private Sub myProc()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsNames As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sales")
Set wsNames = wb.Worksheets("Names")
Dim namesArr()
namesArr = wsNames.Range("J3:J" & wsNames.Cells(wsNames.Rows.Count, "J").End(xlUp).Row).Value
If UBound(namesArr, 1) <> wsSource.Range("ITEMName").Rows.Count Then
MsgBox "There are not a matching number of named ranges listed in Names sheet."
Exit Sub
End If
Dim i As Long
Dim currLastRow As Long
'Any optimization code could actually go in outer calling sub but consider
'some such as the following
Application.ScreenUpdating = False
Dim copyRow As Range
For i = LBound(namesArr, 1) To UBound(namesArr, 1)
With wb.Worksheets(namesArr(i, 1))
Set copyRow = wsSource.Range(namesArr(i, 1)).EntireRow
If IsEmpty(.Range("A1")) Then 'First row in sheet is available
.Rows(1).Value = copyRow.Value2
Else
currLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(currLastRow + 1).Value = copyRow.Value2
End If
End With
Next i
Application.ScreenUpdating = True
End Sub
Version 2:
Looping Named Ranges in Sales sheet (assumes only 101 Named Ranges in the sheet, tested with workbook scope, and that you will ignore 1 of these which is called ITEMName, no list required in a different sheet. Approach adapted from #user1274820.
Option Explicit
Private Sub myProc2()
Dim wb As Workbook
Dim wsSource As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Worksheets("Sales")
Dim currLastRow As Long
'Any optimization code could actually go in outer calling sub but consider
'some such as the following
Application.ScreenUpdating = False
Dim copyRow As Range
Dim nm As Variant
For Each nm In ThisWorkbook.Names
If nm.RefersToRange.Parent.Name = "Sales" And nm.Name <> "ITEMName" Then
With wb.Worksheets(nm.Name)
Set copyRow = wsSource.Range(nm.Name).EntireRow
If IsEmpty(.Range("A1")) Then 'First row in sheet is available
.Rows(1).Value = copyRow.Value2
Else
currLastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
.Rows(currLastRow + 1).Value = copyRow.Value2
End If
End With
End If
Next nm
Application.ScreenUpdating = True
End Sub
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.
In Sheet1, I have rows of data points for several different measures (columns). I manually created a second sheet which performs some analysis on the first column of data. How can I create a macro or VBA code such that a new sheet is created for each of the columns in Sheet1 and the exact same analysis is performed as the one I created manually? Thanks.
Create a "template" analysis sheet with a place to paste a column of data, then make copies of that template and copy-paste in the relevant column from Sheet1.
Eg:
Sub Tester()
Dim rngData As Range, col As Range, colNum As Integer
Dim shtTemplate As Worksheet, shtData As Worksheet
Set shtData = Sheets("Sheet1")
Set shtTemplate = Sheets("Template")
Set rngData = shtData.Range("A1").CurrentRegion
colNum = 0
For Each col In rngData.Columns
colNum = colNum + 1
shtTemplate.Copy before:=shtTemplate
With Sheets(shtTemplate.Index - 1)
.Name = "Column " & colNum
col.Copy .Range("A1")
End With
Next col
End Sub