Need help with my code please. I want to search all worksheets in a workbook that contain a specific string in its sheet name to copy cell data of a range and paste as values into a different ws. I keep getting Run-Time error '9' subscript out of range. It highlights Set wsSumm = ThisWorkbook.Sheets("Summary") as the reasoning. I have a Summary tab so I am unsure why it is giving this error.
What I ultimately need to do is take data from A2 of all BL ws and paste into Column A of Summary ws. Then take A1 of all SL ws and paste into Column B of Summary ws. I would need to paste as values. My sheets are named 1-15 as BL, SL (BL1, SL1, BL2, SL2, BL3, SL3, ect) and a Summary ws. Below is what my Workbook looks like and the Code I am using.
[enter image description here][1]
Option Explicit
Sub Macro1()
Dim wsSumm As Worksheet, ws As Worksheet
Dim strCol As String
Dim lngRow As Long
Application.ScreenUpdating = False
Set wsSumm = ThisWorkbook.Sheets("Summary") '<-Sheet name for the data to be concolidated. Change to suit.
For Each ws In ThisWorkbook.Sheets
If ws.Name <> wsSumm.Name Then
strCol = IIf(StrConv(Left(ws.Name, 2), vbUpperCase) = "BL", "A", "B")
lngRow = IIf(StrConv(Left(ws.Name, 2), vbUpperCase) = "BL", 2, 1)
wsSumm.Range(strCol & Rows.Count).End(xlUp).Offset(1, 0).Value = ws.Range("A" & lngRow)
End If
Next ws
Application.ScreenUpdating = True
End Sub
Related
screenshot of code
I am trying to calculate sum in cell "I13" of sheet2 with inputs based on the dynamic range.
Formula
range("I13").formula= "=sum('sheet1'!A1:A3)"
works but the range can be dynamic. For this I have used lr to identify the last row in the range
lr=cells(rows.count,1).end(xlup).row
Now, I want to modify the above formula such that in place of A3, it takes last cell. i.e. A&lr
Have tried using range("I13").formula= "=sum('sheet1'!A1:A"&lr)", but it results in error
Sub MMM()
Windows("Template.xlsx").activate
sheets("sheet1").select
range("a1").select
lr=cells(rows.count,1).end(xlup).row
sheets("sheet2").select
'this code works. But want dynamic range
'range("I13").formula = "= SUM('sheet1'!A1:A3)"
range("I13").formula = "= sum('sheet1'!A1:A&lr)"
End Sub
you can try to define the variable:
Option Explicit ' It should be used when you define variable
Sub MMM()
Dim lr as Range ' Define variable
Windows("Template.xlsx").activate
sheets("sheet1").select
range("a1").select
lr=cells(rows.count,1).end(xlup).row
sheets("sheet2").select
range("I13").formula = "= sum('sheet1'!A1:A&lr)"
End Sub
You have to join the string for the formula like this:
"=SUM('Sheet1'!A1:A" & lastRow & ")"
Alternatively:
If you set the whole range to be summed then you can use the Address of this range. The External-parameter returns the sheet name as well.
Sub MMM()
Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsSource As Worksheet: Set wsSource = wb.Worksheets("Sheet1")
Dim wsTarget As Worksheet: Set wsTarget = wb.Worksheets("Sheet2")
Dim rgDataToSum As Range
With wsSource
Set rgDataToSum = .Range("A1", .Cells(.Rows.Count, 1).End(xlUp))
End With
wsTarget.Range("I13").Formula = "=SUM(" & rgDataToSum.Address(True, True, External:=True) & ")"
End Sub
I have a report I receive once a week with multiple data blocks that have dynamic rows and columns and each data block has a static title that will never change that are separated by a blank row. I am trying to copy these blocks into sheets based off of these titles.
I have a script that is creating the sheets and blank rows between data blocks with Python. But I am hoping to do the rest with VBA. Here is the end result Example.
Currently each of those sheets are blank, and I want to either copy paste or cut and paste the blocks into those sheets without their titles. i.e. A41:C46 into the Unanswered Service Level sheet.
Sub FormatExcel()
Dim LR As Long, i As Long
With Sheets("Master")
LR = .Range("A" & Rows.Count).End(xlUp).Row
For i = 1 To LR
With .Range("A" & i)
If .Value = "All Call Distribution by Queue" Then
ActiveCell.CurrentRegion.Select
Selection.Copy
Sheets("All Calls by Queue").Select
ActiveSheet.Paste
End If
End With
Next
End With
End Sub
This is what I have so far.
It will copy/paste into the designated sheet. But I'm stuck on why it's adding a second blank row at the top and how to code it so that if the sheet doesn't exist then nothing will happen. I am very new to VBA but I pieced this together from other code and just recording macros. Otherwise I was just going to copy and paste this code 15 times just with different sheet titles and .Values
You can use an approach like this:
Sub FormatExcel()
Dim ws As Worksheet, wb As Workbook
Set wb = ThisWorkbook 'ActiveWorkbook?
Set ws = wb.Worksheets("Master")
CopyBlock ws, "All Call Distribution by Queue", "All Calls by Queue"
CopyBlock ws, "Title2", "Title2 sheet"
'etc etc
End Sub
Sub CopyBlock(ws As Worksheet, title As String, destWS As String)
Dim f As Range, rng As Range, wsDest As Worksheet
'check if destination worksheet is present
On Error Resume Next 'ignore any error
Set wsDest = ws.Parent.Worksheets(destWS) 'check in same workbook as `ws`
On Error GoTo 0 'stop ignoring errors
If wsDest Is Nothing Then
Debug.Print "Missing sheet '" & destWS; "' in workbook '" & ws.Parent.Name & "'"
Exit Sub
End If
Set f = ws.Columns("A").Find(what:=title, lookat:=xlWhole) 'search header
If Not f Is Nothing Then 'got a match?
Set rng = f.CurrentRegion
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1) 'exclude header row
rng.Copy wsDest.Range("A1") 'copy to specific location
End If
End Sub
I have a workbook with multiple sheets ,the number of sheets can change for each project but they all end with PAF. The table is the same across all sheets as well as the cells.
I have a summary tab with the exact same table, I just need to sum it all up there, the table has at least 6 columns and 20 rows so each cell would need the same formula (basically) so I came up with the following but I'm getting an error. Any suggestions?
Sub SumPAF
Dim ws as Worksheet
Sheets("Summary PAF").Activate
For Each ws In ActiveWorkbook.Worksheets
If ws.Name Like "PAF" Then
Range("E10") = WorksheetFunction.Sum(Range("E10"))
End If
Next
End Sub
It's getting stuck in "For Each" saying that an Object is required...
I have commented the code so you should not have a problem understanding it.
Option Explicit
Sub SumPAF()
Dim ws As Worksheet
'~~> This will store the cell addresses
Dim sumFormula As String
'~~> Loop though each worksheet and check if it ends with PAF
'~~> and also to ingore summary worksheet
For Each ws In ActiveWorkbook.Worksheets
If UCase(ws.Name) Like "*PAF" And _
InStr(1, ws.Name, "Summary", vbTextCompare) = 0 Then _
sumFormula = sumFormula & "," & "'" & ws.Name & "'!E10"
'~~> or simply
'sumFormula = sumFormula & ",'" & ws.Name & "'!E10"
Next
'~~> Remove the intital ","
sumFormula = Mid(sumFormula, 2)
'~~> Insert the sum formula
If sumFormula <> "" Then _
Sheets("Summary PAF").Range("E10").Formula = "=SUM(" & sumFormula & ")"
End Sub
Here's a very simple and easy to understand program to illustrate how VBA can be used for loops over ranges. If you have any questions, feel free to ask:
Sub SumPAF()
'Save a reference to the Summary Sheet
Dim SummarySheet As Worksheet
Set SummarySheet = Sheets("Summary PAF")
'Save a reference to the Summary Table and decide the table dimensions
Dim SummaryTable As Range
Set SummaryTable = SummarySheet.Range("A1:F20")
'Create an array to save the sum values
Dim SumValues() As Double
ReDim SumValues(1 To SummaryTable.Rows.Count, 1 To SummaryTable.Columns.Count)
'Loop through the workbook sheets
Dim ws As Worksheet, TableRange As Range
For Each ws In ActiveWorkbook.Worksheets
'Find sheets ending in PAF other than the summary PAF
If ws.Name Like "*PAF" And Not ws.Name = SummarySheet.Name Then
'create a reference to a range on the sheet in the same place and dimensions as the summary table
Set TableRange = ws.Range(SummaryTable.Address)
'loop through the range, cell by cell
Dim i As Long, j As Long
For i = 1 To TableRange.Rows.Count
For j = 1 To TableRange.Columns.Count
'Sum each cell value into the array, where its cell address is the array coordinates.
SumValues(i, j) = SumValues(i, j) + TableRange.Cells(i, j).Value
Next j
Next i
End If
Next
'Output the array into the summary table
SummaryTable.Value = SumValues
End Sub
I am brand new to VBA coding and am confused on how I would be able to copy and paste values from one sheet to another if two criteria points are met. In the sheet below I want to copy "12, 9, and 15" and paste it into the "Expected, P10 and P90" cells on sheet2 if the names on sheet one "Orange, Green" match those on sheet 1.
I've been attempting this on my own for quite some time now with now luck.
Attached is the code I started
Sub Copy_Certain_Data()
a = Worksheets("Schedule Results").Cells(Rows.Count, 1).End(xlUp).Row
For i = 3 To a
If Worksheets("Schedule Results").Cells(i, 3).Value = "NE2P1" Then
Worksheets("schedule results").Rows(i).Copy
Worksheets("Campaign 1 Data").Activate
Range("F2").Select
ActiveSheet.Paste
Worksheets("Schedule Results").Activate
End If
Next
Application.CutCopyMode = False
End Sub
Below is a basic macro to loop through two worksheets and find the row that has matching values in columns A and B. Then writing the values from the row in sheet 1, columns C:E to the row in sheet 2, columns D:F.
Dim ws1 As Worksheet, ws2 As Worksheet
Dim xCel As Range, yCel As Range
Set ws1 = ThisWorkbook.Sheets("Sheet1") 'change sheet names as needed
Set ws2 = ThisWorkbook.Sheets("Sheet2")
For Each xCel In ws1.Range("A2", ws1.Range("A" & ws1.Rows.Count).End(xlUp)) 'loop sheet1 column A
If xCel.Value = "Orange" And xCel.Offset(, 1).Value = "Green" Then 'when both values are found in row goto sheet2 loop
For Each yCel In ws2.Range("A2", ws2.Range("A" & ws2.Rows.Count).End(xlUp)) 'Loop sheet2 Column A
If yCel.Value = "Orange" And yCel.Offset(, 1).Value = "Green" Then 'when found write values from sheet1 to sheet2
yCel.Offset(, 3).Resize(, 3).Value = xCel.Offset(, 2).Resize(, 3).Value
End If
Next yCel
End If
Next xCel
This should give you a start to get you what you are trying to accomplished based on the code you have tried. Its always best practice to set your variables and also qualify worksheets.
Using .copy and .paste can cause issues because if the cells are not the same size you will get an error stating such and that is why I always set the destination cell value = the source cell value.
Option Explict
Sub Copy_Certain_Data()
Dim wb As Workbook
Dim wsSource As Worksheet
Dim wsDest As Worksheet
Set wb = ThisWorkbook
Set wsSource = wb.Sheets("Schedule Results")
Set wsDest = wb.Sheets("Campaign 1 Data")
Dim LastRow As Long, i As Long
LastRow = wsSource.Cells(wsSource.Rows.Count, "A").End(xlUp).Row
For i = 3 To LastRow
If wsSource.Cells(i, 3).Value = "NE2P1" Then
wsDest.Cells(i, 6) = wsSource.Cells(i, 3)
End If
Next i
End Sub
I have this code where it loops through all the sheets in the workbook and copies the value in F9 of each sheet and pastes it in "Summary" sheet column A. How can I also print the sheet name in column B? So the value is next to the sheet name in the "Summary" sheet.
code:
Sub loopsheet()
Dim wks As Worksheet
For Each wks In ThisWorkbook.Worksheets
If Not wks.Name = "Summary" Then
wks.Range("F9:F" & wks.Cells(Rows.Count, "F").End(xlUp).Row).Copy _
Destination:=Worksheets("Summary").Cells(Rows.Count, "A").End(xlUp).Offset(1)
End If
Next
End Sub
Thank you
Create two variables to track the last rows of your sheets as you loop. This will help with readability in your code. The combination of these two variables can also help you deduce the size of the range where you need to drop your sheet name.
I believe cLR + pLR - 11 is the size of range. The offset is due to headers, LR offset, and the fact that you are starting your copy from the 9th row. After you run this, you may need to tweak it up or down one if i'm wrong.
Option Explicit
Sub LoopSheet()
Dim ws As Worksheet
Dim Summary As Worksheet: Set Summary = ThisWorkbook.Sheets("Summary")
Dim cLR As Long, pLR As Long
For Each ws In ThisWorkbook.Worksheets
If ws.Name <> Summary.Name Then
cLR = ws.Range("F" & ws.Rows.Count).End(xlUp).Row
pLR = Summary.Range("A" & Summary.Rows.Count).End(xlUp).Offset(1).Row
ws.Range("F9:F" & cLR).Copy Summary.Range("A" & pLR)
Summary.Range(Summary.Cells(pLR, 2), Summary.Cells(cLR + pLR - 11, 2)).Value = ws.Name
End If
Next ws
End Sub