Maybe somebody can help me with this one very basic problem that I have which is driving me nuts. I just need to copy some data from one sheet to another one depending on its output.
The variables have been defined previously and wMod and wRes stand for worksheets, countP and countC stands for the total amount of cells calculated in another worksheet.
What I need to do is to write a code that would be able to copy data with the value in cell B which has the number 1 in it, paste and paste it in another sheet. When I write the code below though, I only get in column A, sheet wRes the total amount of cells that were stored in variable countP.
You can see what kind of output I get below with the picture I attached.Data output Anybody has any idea why I cannot get the right output? Been stuck with this problem for hours.
For i = 3 To countP
If wMod.Range("B" & i) = 1 Then
For j = 3 To countC1
wMod.Range("A" & i).Copy wRes.Range("A" & j)
Next j
End If
Next i
The following code will check the Last Row with Data on Sheet1 Column A, then it will loop from row 2 to the Last and check if Column B = 1, then it will check the last row with data on Sheet2 Column A, and paste the value in the next row (ie. next empty row).
It goes like so:
Sub foo()
Dim ws As Worksheet: Set ws = Sheets("Sheet1")
Dim ws2 As Worksheet: Set ws2 = Sheets("Sheet2")
Dim LastRow As Long
Dim LastRow2 As Long
LastRow = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
'find the last row with data on Column A in Sheet1
For i = 2 To LastRow 'loop from row 2 to last
If ws.Range("B" & i) = 1 Then 'if column B in Sheet1 = 1 then
LastRow2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row 'find the last row with data on Sheet2 Column A
ws2.Cells(LastRow2 + 1, 1) = ws.Range("A" & i)
End If
Next i
End Sub
Related
I have a master dataset in one sheet something like this
In another sheet I want to extract Data from this Master Data set based on a cell value which will have Department as Criteria.
So ,For example if in sheet 2 I type my my Department criteria as Sales, All the rows with Department as Sales should get populated in Sheet 2.
Can this be done by excel functions/Macros/VBA ?
Thanks in advance.
Pardon me if you find this query absurd .
Yes it can be done. Add this code to a module in your workbook. You can run it right from the debugger, or go to macros and assign it a hotkey, or you can create a button on the sheet and put this code inside the button click event. There are probably more efficient ways to do this but it shouldn't matter unless you have a lot of data. I've been explicit so you can see whats going on. I've used the sheet names "Data" and "View" you will have to change the names in the code to match your workbook.
EDIT: I'm also assuming that the top left cell in your screenshot is A1, if not you will have to adjust the code.
Sub GetDepartments()
Dim LastRow As Long
Dim MyRange As Range
Dim SourceRow As Long
Dim DeptValue As String
Dim OutputRow As Long
Dim ColCounter As Long
'get size of current view sheet and clear
LastRow = ThisWorkbook.Worksheets("View").Cells(ThisWorkbook.Worksheets("View").Rows.Count, "A").End(xlUp).Row
If LastRow > 7 Then
Set MyRange = ThisWorkbook.Worksheets("View").Range("A7:C" & LastRow)
MyRange.ClearContents
End If
'get size of data sheet
LastRow = ThisWorkbook.Worksheets("Data").Cells(ThisWorkbook.Worksheets("Data").Rows.Count, "A").End(xlUp).Row
'get value to match
DeptValue = ThisWorkbook.Worksheets("View").Cells(3, 2).Value
'track outputrow
OutputRow = 7
'loop through all rows in data
For SourceRow = 2 To LastRow
'if match found
If ThisWorkbook.Worksheets("Data").Cells(SourceRow, 2).Value = DeptValue Then
'copy 3 cols
For ColCounter = 1 To 3
ThisWorkbook.Worksheets("View").Cells(OutputRow, ColCounter).Value = _
ThisWorkbook.Worksheets("Data").Cells(SourceRow, ColCounter).Value
Next ColCounter
'increment outputrow
OutputRow = OutputRow + 1
End If
Next SourceRow
End Sub
I would like to copy entire row from today Sheet to last available row of main Sheet if today Sheet B2:B cell value = "Update". However, I come up with copy area and paste area are not the same size issue. I've tried many ways but cannot get it solved. Can anyone help? Thanks in advanced.
Sub getnew()
Dim Sheet1 As Worksheet
Dim Sheet3 As Worksheet
Dim lastrow As Integer
Dim i As Integer
Set Sheet1 = ThisWorkbook.Sheets("main")
Set Sheet3 = ThisWorkbook.Sheets("today")
lastrow = Sheet3.Range("C" & Rows.Count).End(xlUp).Row
Dim erow As Long
For i = 2 To lastrow
erow = Sheet1.Range("C" & Rows.Count).End(xlUp).Row + 1
If Sheet3.Cells(i, 2).Value = "Update" Then
Sheet3.Cells(i, 2).EntireRow.Copy Destination:=Sheet1.Range("B" & erow)
End If
Next i
End Sub
You are trying to copy the entire row of a worksheet, but you are pasting that row in another sheet, starting at column B. They aren't the same size, because an entire row contains 16,384 columns, but a row starting at column B only has 16,383 columns.
You have a few options to resolve this:
You could paste the entire row onto the other sheet at column A, like so:
Sheet3.Cells(i, 2).EntireRow.Copy Destination:=Sheet1.Range("A" & erow)
Or you could copy only the number of columns which you care about, instead of trying to copy the entire row, like so [I don't know what it is you're trying to copy, so you will need to figure out how exactly you want to size it. I have assumed that 10 columns is sufficient]:
Sheet3.Range(Cells(i, 2), Cells(i,11)).Copy Destination:=Sheet1.Range("B" & erow)
So I have been stumped by this for a while now. I have two sheets with some values in column 1 bolded. I wish to filter through the values on the second sheet (Mult. Year Set up) and copy the entire row of data with the same column 1 bolded Text.
Page from Which data is to be coppied
Page Which Data is to be coppied to
For example I would like to take the "Backhoes" row from the first link and copy it to the "Backhoes" row on the Second link.
The major issue here is that the rows on the first page with bolded text are variable and may not allways have the same row number. The row numbers will change when more equipment is added.
Thanks in advance for the assistance, as I said, I have been working on this for a few days now.
Additionally, the data must be transposed from a row to a column, but that is a minor detail.
Look at something like this.
1. Loop through the rows looking for bold cells.
2. Loop through all the columns and copy the data from the source sheet to the target sheet.
Dim lRow As Long
Dim lCol As Long
Dim lRowFind As Long
Dim sourceSheet As Excel.Worksheet
Dim targetSheet As Excel.Worksheet
Set sourceSheet = ActiveWorkbook.Sheets("Current Year Budget")
Set targetSheet = ActiveWorkbook.Sheets("Mult. Year Set up")
lRow = 5
Do While lRow <= sourceSheet.UsedRange.Rows.count
'You could do it by name
'If ws.Range("A" & lRow).Value = "Backhoes" Or ws.Range("A" & lRow).Value = "Graders" Then
'If we are looking for variable rows by them being bold. We can do this.
If sourceSheet.Range("A" & lRow).Font.Bold = True Then
'Find the row on the target sheet where we want to write the data.
lRowFind = 1
Do While lRowFind <= targetSheet.UsedRange.Rows.count
If targetSheet.Range("A" & lRowFind).Value = sourceSheet.Range("A" & lRow).Value Then
Exit Do
End If
lRowFind = lRowFind + 1
Loop
'Now we have a row that we want to copy.
For iCol = 1 To sourceSheet.UsedRange.Columns.count
targetSheet.Cells(lRowFind + iCol, 2).Value = sourceSheet.Cells(lRow, iCol).Value
Next iCol
End If
lRow = lRow + 1
sourceSheet.Range("A" & lRow).Activate
Loop
I have a workbook with two excel sheets: sheet1 and sheet2. In sheet1 I have a large amount of data from column B to CE.
Using VBA I am currently copying each row from Sheet1 in the range "B3:AP3" to Sheet2 duplicating each line so it will be represented twice. This is working fine!
The problem i have as that in Sheet2 I now need to make a calculation. In Sheet1 I have a number in cell CE and CF for each row. As these rows have been duplicated I need to multiply the number in cell AP3 of Sheet2 with that of CE3 in Sheet1 and that of AP4 in Sheet2 with that of CF3 in Sheet1.
The macro needs to keep on doing this with the subsequent cells. In total cell AP the first duplicated line needs to be multiplied with the number CE3 from Sheet1 and cell AP of the second duplicated line needs to be multiplied with the number CF3 from sheet1. The result should be posted in Sheet2 column AQ.
Below I have posted the code for duplicating and moving the lines but I am really struggling with the multiplications, any help is greatly appreciated!
Sub CopyRows()
Dim ws1 As Worksheet, ws2 As Worksheet
Dim i As Long, k As Long
Dim ws1LR As Long, ws2LR As Long
Set ws1 = Sheets("Bearbejdning")
Set ws2 = Sheets("Sheet8")
ws1LR = ws1.Range("B" & Rows.Count).End(xlUp).Row + 1
ws2LR = ws2.Range("B" & Rows.Count).End(xlUp).Row + 1
i = 2
k = ws2LR
Do Until i = ws1LR
With ws1
.Range(.Cells(i, 1), .Cells(i, 43)).Copy
End With
With ws2
.Cells(k, 1).PasteSpecial
.Cells(k, 1).Offset(1, 0).PasteSpecial
End With
Range("k,AR" & ws2LR).Formula = "=ws1.range(.Cells(i, 73)) * ws2.range(.Cells(k, 36))"
k = k + 2
i = i + 1
Loop
End Sub
You can't pass an object into an excel formula that way.
Try this:
Range(k,"AR" & ws2LR).Formula = "=" & ws1.range(.Cells(i, 73)).address &" * " & ws2.range(.Cells(k, 36)).address
Alternatively, you could place the pre-calculated value in the cell.
Range(k,"AR" & ws2LR).Value = ws1.range(.Cells(i, 73)) * ws2.range(.Cells(k, 36))
Also, this Range call looks strange to me: Range("k,AR").
I think it should be something like Cells(k,"AR").
Variables shouldn't be inside quotes and Range doesn't accept Row/Column parameters.
This is my first time to code in VBA.
I have several worksheets in a file and they are in order by dates.
So what I am trying to do is to collect data sets in a worksheet if they have the same period of time.
date1 value1
date2 value2
date3 value3
Since they are in order I just compare the first date values and if they are different it moves on to the next worksheet. If they are the same then copy the value and do the same process until it reaches the last worksheet.
However it copies one worksheet fine but after that Excel freezes.
I would be appreciated if you find any errors or give me other suggestions to do it.
Following is my code:
Sub matchingStock()
Dim sh1 As Worksheet, sh2 As Worksheet
' create short references to sheets
' inside the Sheets() use either the tab number or name
Set sh1 = Sheets("combined")
Dim col As Long
'since first column is for Tbill it stock price should place from the third column
col = 3
Dim k As Long
'go through all the stock worksheets
For k = Sheets("WLT").Index To Sheets("ARNA").Index
Set sh2 = Sheets(k)
' Create iterators
Dim i As Long, j As Long
' Create last rows values for the columns you will be comparing
Dim lr1 As Long, lr2 As Long
' create a reference variable to the next available row
Dim nxtRow As Long
' Create ranges to easily reference data
Dim rng1 As Range, rng2 As Range
' Assign values to variables
lr1 = sh1.Range("A" & Rows.Count).End(xlUp).Row
lr2 = sh2.Range("A" & Rows.Count).End(xlUp).Row
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
Application.ScreenUpdating = False
' Loop through column A on sheet1
For i = 2 To lr1
Set rng1 = sh1.Range("A" & i)
' Loop through column A on sheet1
For j = 2 To lr2
Set rng2 = sh2.Range("A" & j)
' compare the words in column a on sheet1 with the words in column on sheet2
'Dim date1 As Date
'Dim date2 As Date
'date1 = TimeValue(sh1.Range("A3"))
'date2 = TimeValue(sh2.Range("A3"))
sh1.Cells(1, col).Value = sh2.Range("A1").Value
' find next empty row
nxtRow = sh1.Cells(Rows.Count, col).End(xlUp).Row + 1
' copy the word in column A on sheet2 to the next available row in sheet1
' copy the value ( offset(0,1) Column B ) to the next available row in sheet1
sh1.Cells(nxtRow, col).Value = rng2.Offset(0, 6).Value
'when the date is different skip to the next worksheet
Set rng2 = Nothing
Next j
Set rng1 = Nothing
Next i
'sh3.Rows("1:1").Delete
Else
GoTo Skip
End If
Skip:
col = col + 1
Next k
End Sub
I cannot identify a specific error so this is a list of suggestions that may help you identify the error and may help improve your code.
Suggestion 1
Do you think the Else block of If-Then-Else-End-If is compulsory?
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
Else
GoTo Skip
End If
Skip:
is the same as:
If sh1.Range("A3").Value = sh2.Range("A3").Value Then
:
End If
Suggestion 2
I do not like:
For k = Sheets("WLT").Index To Sheets("ARNA").Index
The value of property Index for a worksheet may not what you think it is. This may not give you the set or sequence of worksheets you expect. Do you want every worksheet except "Combined"? The following should be more reliable:
For k = 1 To Worksheets.Count
If Worksheets(k).Name <> sh1.Name Then
:
End If
Next
Suggestion 3
You use:
.Range("A" & Rows.Count)
.Range("A3")
.Cells(1, col).Value
.Cells(Rows.Count, col)
rng2.Offset(0, 6)
All these methods of identifying a cell or a range have their purposes. However, I find it confusing to use more than one at a time. I find .Cells(row, column) and .Range(.Cells(row1, column1), .Cells(row2, column2)) to be the most versatile and use them unless there is a powerful reason to use one of the other methods.
Suggestion 4
I cannot decypher what this code is attempting to achieve.
You say: "I have several worksheets in a file and they are in order by dates. So what I am trying to do is to collect data sets in a worksheet if they have the same period of time."
If you have set Worksheet("combined").Range("A3").Value to a particular date and you want to collect data from all those sheets with the same value in cell A3 then the outer For-Loop and the If give this effect. But if so, if does not matter how the worksheets are ordered. Also you start checking cell values from row 2 which suggests row 3 is a regular data row.
The outer loop is for each worksheet, the next loop is for each row in "combined" and the inner loop is for each row in the worksheet selected by the outer loop. The middle loop does not appear to do anything but set rng1 which is not used.
Perhaps you can add an explanation of what you are trying to achieve.
Suggestion 5
Are you trying to add an entire column of values from the source worksheets to "Combined". The macro below:
Identifies the next free row in column A of "Combined"
Identifies the last used row in column A of "Sheet2"
Assumes the first interesting row of "Sheet2" is 2.
Adds the entire used range of column A of "Sheet2" (complete with formatting) to the end of "Combined"'s column A in a single statement.
This may demonstrate a better way of achieving the effect you seek.
Sub Test()
Dim RngSrc As Range
Dim RngDest As Range
Dim RowCombNext As Long
Dim RowSrcFirst As Long
Dim RowSrcLast As Long
With Worksheets("Combined")
RowCombNext = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Set RngDest = .Cells(RowCombNext, "A")
End With
With Worksheets("Sheet2")
RowSrcFirst = 2
RowSrcLast = .Cells(Rows.Count, "A").End(xlUp).Row
Set RngSrc = .Range(.Cells(RowSrcFirst, "A"), .Cells(RowSrcLast, "A"))
End With
RngSrc.Copy Destination:=RngDest
End Sub