I have the following vba:
Data is all text, Rows A - J with column headers on every sheet are the same
Data is sql queries all with "top 1000"
4 sheets (sheet1, sheet2, sheet3, Master)
sheet 1: 100 rows
sheet 2: 34 rows
sheet 3: 900 rows
Master: merged data from 3 sheets
PROBLEM: Sheet3 only copies 84 rows specifically however adding more rows to other sheets will copy over to Master. Only sheet3 will not copy more than 84 rows.
' Step 1: Clear master before updating
' Step 2 : Loop through the regional sheets
Sub Consolidate()
Dim cell As Range
Dim wks As Worksheet
Sheets("Master").Range("A2:Z65536").ClearContents
For Each wks In ThisWorkbook.Worksheets
If wks.Name <> "Master" And wks.Range("A2") <> "" Then
For Each cell In wks.Range(wks.Range("A2"), wks.Range("A2").End(xlDown))
cell.EntireRow.Copy Destination:=Worksheets("Master").Range("A65536").End(xlUp).Offset(1, 0)
Next cell
End If
Next wks
End Sub
Is the data starting in Range(A2) always populated?
The For Each cell In wks.Range(wks.Range("A2"), wks.Range("A2").End(xlDown)) will start from A2 and go to the last populated cell before a blank/empty cell.
Related
I'm writing a macro that opens a number of different workbooks, copies data from each, and compiles into a single "master" workbook. In the below code example, wb2 is one of the workbooks and I'm copying from, and wb1 is the master.
lrow3A is the last row of data in the source workbook. Lrow3 is the last row of data in the master workbook.
lrow3A = wb2.Sheets("DCF3").Cells(1048576, 2).End(xlUp).Row
wb2.Sheets("DCF3").Range(Cells(6, 1), Cells(lrow3A, 16)).Copy _
Destination:=wb2.Worksheets("DCF3").Cells(lrow3 + 1, 2)
I'm getting a "Subscript out of range" error on the copy line.
I think you should code:
With wb2.Sheets("DCF3") 'reference "source" worksheet
lrow3A = .Cells(.Rows.Count, 2).End(xlUp).Row ' get referenced sheet column "B" last not empty cell row index
.Range("A6:P" & lrow3A).Copy _
Destination:=wb1.Worksheets("DCF3").Cells(lrow3 + 1, 2) 'copy referenced sheet range in columns A:P from row 6 to row 'lrow3A' and paste it to "master" workbook sheet "DCF3" starting from its column B cell at row 'lrow3'+1
End With
I have been trying to get this to work, but I am not sure how to get it to work, any help would be appreciated.
I have 2 workbooks, workbook 1 has multiple sheets, each one labelled with a different name. Workbook 2 has one summary sheet with a column of values for each individual.
What I am trying to achieve is:
on workbook 1 check the sheet name
switch to workbook 2 and find the column with the same name. All the names are on row 6, from column I to DD. Also, each name is in 2 cells merged together, I don't know if this affects it.
Once the name on row 6 is found, I want it to go down 6 cells, and copy the value.
switch back to workbook 1 and paste it into cell B37.
Repeat this process but this time go down 7 cells, copy the value and paste it into cell B102 OF Workbook 1. I have about 30 cells to copy and past like that.
once complete repeat everything again for the next sheet on workbook 1.
Another Important issue is that, not all sheet names on workbook 1 exists on workbook 2, I have a feeling the below code will throw an error as soon as it doesn't find a match. So I would like to be able to skip the sheets on workbook 1 that it doesn't find a matching name for on workbook 2 summary sheet.
I have put the code I have below, but I keep getting the error "Method or data member not found"
Sub Measures()
Dim wb1 As Workbook
Dim Sht As Worksheet
Dim Rng, Rng2 As Range
Dim wb2 As Workbook
Dim cell As Range
Dim ws As Worksheet
Set wb1 = ThisWorkbook
Set wb2 = Workbooks("November Stream 1.xlsm")
Set Sht = wb1.Worksheets("Summary")
Set Rng = Sht.Range("A6:A" & Sht.Cells(Sht.Column.Count, "A").End(xlUp).Column)
For Each cell In Rng
Set ws = wb2.Sheets(cell.Text)
ws.Range("B37").Value = cell.Offset(6, 0).Value
ws.Range("B102").Value = cell.Offset(7, 0).Value
Next cell
End Sub
Thank you for any help!
I am trying to get the correct VBA code that will allow me to insert a row in to a filtered table at the same place on multiple worksheets and copy all of the content from the entire row above.
There is a check box relating to each sheet in the workbook. If the check box is ticked then the row should be inserted in to this sheet.
The sheets are password protected. The password is found in another of the worksheets in the file.
I have almost got this to work. My file can be found at the following location:
https://drive.google.com/file/d/0B5HnHgSNFkFid0gwbDNMOFN1NUU/view?usp=sharing
The code is as follows:
Sub Insert_Rows()
Dim sh As Worksheet
For Each sh In Sheets
If sh.Name = "Sheet1" And Worksheets("Sheet4").Range("D1").Value = True Or _
sh.Name = "Sheet2" And Worksheets("Sheet4").Range("D2").Value = True Or _
sh.Name = "Sheet3" And Worksheets("Sheet4").Range("D3").Value = True Then
With sh
.Unprotect Password:=Worksheets("Sheet4").Range("A1")
.Cells(ActiveCell.Row, 4).EntireRow.Insert
.Range(.Cells(ActiveCell.Row, 1), .Cells(ActiveCell.Row, 4)).FillDown
.Protect DrawingObjects:=True, contents:=True, Scenarios:=True, Password:=Worksheets("Sheet4").Range("A1")
End With
End If
Next sh
End Sub
The issue I am having is that not all of the data from the row above is being copied. The data in the 5th column is not copying down. I am sure it is something to do with the 4 in the code .Cells(ActiveCell.Row, 4). I want it to copy the entire row above regardless of the number of columns.
Any help greatly appreciated.
Thanks
To FillDown the EntireRow, instead of just the Range between column 1 and column 4, replace
.Range(.Cells(ActiveCell.Row, 1), .Cells(ActiveCell.Row, 4)).FillDown
with
.Cells(ActiveCell.Row, 1).EntireRow.FillDown
(which could also be written as .Rows(ActiveCell.Row).FillDown)
Note:
Please remember that ActiveCell.Row is not necessarily referring to any special location on Sheet1, Sheet2, or Sheet3.
If the currently active cell is cell G67 on sheet Sheet4, then ActiveCell.Row will evaluate to 67 and so row 66 of Sheet1 (and/or Sheet2 and/or Sheet3) will be copied to a newly inserted row on Sheet1 (and/or Sheet2 and/or Sheet3) - it won't magically decide to insert row 58 on Sheet1 and row 82 on Sheet2, etc.
If the only problem you are having is that the entire row is not being filled down, then the solution above will fix it. But if you find that the wrong row is being filled down, then you will need to rethink how you are selecting the row.
I receive a monthly aging report. I need to compare these 2 reports to find out what items appear on each of the reports. I need a VBA to look at Column B of both sheets and if there is a match, extract those rows only. In addition, I need a vba to find out if something has changed. For those that are not familiar with aging report, this reports tells me how far the customer is past due in paying me. So if customer 1, was in the Aging 0-30 (Column S) on report pulled on 20151023, then on the report pulled 20160223, this customer should be in Aging 90-120 (Column V). I'm thinking the best way to display this information is to display matched data with no changes in the No Changes Sheet. Then, in the sheet called Changes, I would like to display about 6 columns of information: Report Date, Dealr, Contract Number, Status, Aging History, & AR Amount. The Aging History will tell me what bucket this customer was on when the report was pulled. This information will come from the column headings (S-X). The AR Amount will be the amount appearing in that column. I will try to upload a sample.
The following gives you a way to compare the same column in two sheets. The first way looks for a matching value anywhere in the second sheet's column, the second method only returns a match if the matching cells are on the same row in both sheets
Sub CompareSheets(sheet1 As Worksheet, sheet2 As Worksheet, columnNumber As Long)
Dim ws1 As Worksheet, ws2 As Worksheet
Dim ws1Data As Range, ws2Data As Range
Dim col As Long
Dim i As Integer
Dim cell1 As Range, cell2 As Range
Set ws1 = sheet1
Set ws2 = sheet2
col = columnNumber
ws1Data = ws1.Columns(col).Cells
ws2Data = ws2.Columns(col).Cells
Find a match anywhere in either column
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' This code will find any match between the two sheets
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
'Checks each cell in the target column of sheet 1
For Each cell1 In ws1Data
'Checks each cell in the target column of sheet 2
For Each cell2 In ws2Data
'If the cell from sheet 1 matches any cell in sheet 2 then do stuff
If cell1 = cell2 Then
'Do stuff with the data here
End If
Next cell2
Next cell1
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
' XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX
Find a match only if the matching cells are on the same row
' ////////////////////////////////////////////////////////
' This code will find a match ONLY if both entries are
' on the same row in their respective sheets
' ////////////////////////////////////////////////////////
'Checks each cell in the target column of sheet 1
For Each cell1 In ws1Data
'Checks each cell in the target column of sheet 2
For Each cell2 In ws2Data
'If the cell from sheet 1 matches any cell in sheet 2
'AND there are on the same row in both sheets then do stuff
If (cell1 = cell2) And (cell1.Row = cell2.Row) Then
'Do stuff with the data here
End If
Next cell2
Next cell1
' /////////////////////////////////////////////////////////
' /////////////////////////////////////////////////////////
End Sub
Then you can make a button or macro that calls the sub
Call CompareSheets(firstworksheet, secondworksheet, 2) '2 is the column number for B
A proper example
Call CompareSheets(Worksheets(1), Worksheets(2), 2)
As for what you want to do with the matches once they're located, that's really for another post.
As a beginner in field of macros, I need advise on how to copy/paste an entire row if column R has value = "YES", from sheet "database", to the next available blank row in sheet2.
Also Sheet2 is another file/workbook at location "C:\Users\Desktop\KPIs"
Example assumes the workbook you want to paste to is already open.
If R1 is "YES" then it copies row 3 to row 3 in the Target workbook
Sub CopyRow()
Dim copyRng As Range
If Worksheets("Database").Range("R1") = "YES" Then
Worksheets("Database").Range("A3").EntireRow.Copy Destination:=Workbooks("Target").Worksheets("Sheet1").Range("A3")
End If
End Sub