So I'm trying to transpose data with two rows and 238 columns to a list (two columns and 238 rows) that I can then filter to remove the rows that have cells with no values next to them. I'm pretty novice when it comes to VBA, so it took me a while to get the code to work for the transpose function, but when I finally got the data transposed, each column became two duplicate rows (instead of just one), and when it reaches the last category (last column in original configuration), the duplicates continue for about 300 rows. I'm not sure where I went wrong, but I hope the issue is obvious so someone can give me a quick answer haha
Here is the code that I have:
Sub Transpose()
ThisWorkbook.Worksheets("Training List by Position").Range("A4:B10000").Clear
Dim Range1 As Range, Range2 As Range, Rng As Range
Dim rowIndex As Integer
Set Range1 = ActiveWorkbook.Worksheets("Training List by Position").Range("A1:IB2")
Set Range2 = ActiveWorkbook.Worksheets("Training List by Position").Range("A4:B300")
columnIndex = 0
Application.ScreenUpdating = False
For Each Rng In Range1.Columns
Rng.Copy
Range2.Offset(columnIndex, 0).PasteSpecial Paste:=xlPasteAll, Transpose:=True
columnIndex = columnIndex + Rng.Rows.Count
Next
Application.CutCopyMode = False
Application.ScreenUpdating = True
End Sub
I think you're over-complicating this a bit - why do you need anything more than this?
Range("A1:IB2").Copy
Range("A4").PasteSpecial Paste:=xlPasteAll, Operation:=xlNone, SkipBlanks:= _
False, Transpose:=True
dwirony's answer is the best to solve your problem, but if you want to know why each column is duplicating, it happens because rng.rows.count is adding 2 (two) to columnIndex every loop, since in your original data there are two rows of every column.
also it does fill 300 rows because you're asking excel to fill the entire range of Range2 variable, every iteration it pastes to A4:B300, goes down two rows and repeat
Related
So I've had to write two almost identical code blocks to loop through my two named ranges. However, I know that the named ranges will always be the same size and shape as each other and even start in the same column (different rows) and they also need to be pasted into two columns next to each other so I feel like this should be possible in one code block but can't even think how to start attacking it. E.g. Cash Payments Monthly is in array A10:D20 and P&L Payments Monthly is in array A40:D50.
Anyone got any ideas, please and thank you?
For Each Row In Range(Names("Cash_Payments_Monthly")).Rows
LastRow = wsDashData.Cells(Rows.Count, 14).End(xlUp).Row
Row.Copy
wsDashData.Range("n" & LastRow + 1).PasteSpecial _
Paste:=xlPasteValues, _
Transpose:=True
Next Row
For Each Row In Range(Names("PL_Payments_Monthly")).Rows
LastRow = wsDashData.Cells(Rows.Count, 15).End(xlUp).Row
Row.Copy
wsDashData.Range("o" & LastRow + 1).PasteSpecial _
Paste:=xlPasteValues, _
Transpose:=True
Next Row
Assuming you have other named ranges in your workbook, you should start by creating a whitelist array of named ranges that you WOULD like to search, then iterate through that array, embedding a single copy of your existing code in that loop...
Dim myranges()
Dim c As Integer 'counter
myranges = Array("Cash_Payments_Monthly", "PL_Payments_Monthly")
For c = 0 To UBound(myranges)
For Each Row In Range(myranges(c)).Rows
...the rest of your code, but just one instance of it :-) ...
Next c
Each week I pull data for a series of items and generate a pivot table. Some weeks, no data exists for one or more of these items. When this is the case, that item won't appear on the report.
To avoid manually checking that no items have been accidentally excluded from the pivot table, I want to manually add "dummy" items to the data used in the pivot table.
I am pretty confident I can identify which dummy items to add by using COUNTIF between the master item sheet and the raw data. My challenge is that the number of rows in the pivot table varies week to week, so I need to 1) identify the last row of the raw data report, and 2) insert dummy rows below the last line.
Can anyone suggest a strategy using the example below?
Items in Data
AAA
BBB
DDD
FFF
Items Not in Data to Manually Insert
CCC
EEE
I am not getting any errors, but this isn't working.
Sub DUMMY_ITEMS()
'
' DUMMY_ITEMS Macro
Sheets("Operations").Select
Range("H2:V73").Select
Selection.Copy
Sheets("Raw Data").Select
Dim LastRow As Long
With ActiveSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub
Thanks for your code in the comment here is the fixed version:
Sub DUMMY_ITEMS()
Dim operationsSheet As Worksheet
Dim rawDataSheet As Worksheet
Dim copyRange As Range
Dim LastRow As Long
Set operationsSheet = Sheets("Operations")
Set rawDataSheet = Sheets("Raw Data")
operationsSheet.Range("H2:V73").Copy
With rawDataSheet
LastRow = .Cells(.Rows.Count, "A").End(xlUp).Row
End With
rawDataSheet.Cells(LastRow, 1).PasteSpecial xlPasteValues
End Sub
I would however highly recommend you look into the Offset solution below to have a dynamic pivot data source.
On top of all that there is a neat trick to always keep your pivot table up to speed:
Create a named range of a name rData
=OFFSET($A$1;;;COUNTA(A:A);COUNTA(1:1))
Where A1 is the begging of your PivotTable, COUNTA(A:A) counts the amount of rows it needs to extend the range to (pick any column that is filled in for all records), and COUNTA(1:1) counts the amount of headers.
Put rData as pivot source. rData will extend any time you add a row or column. No macros needed.
I usually assign the full table to a data range
Set currentData = ActiveWorksheet.Range("A1").CurrentRegion
Where Range("A1") is the beggining of the dataset
with currentData
lastRow = .rows(.rows.count).row
end with
May not be the most optimal way to do it but works for me
Then you can thing underneath using
ActiveWorksheet.Cells(lastRow+1,1).Value = "CCC"
ActiveWorksheet.Cells(lastRow+2,1).Value = "EEE"
Or you can use offset
Set rangeToFill = ActiveWorksheet.Cells(lastRow,1)
rangeToFill.offset(1,0).value ="CCC"
rangeToFill.offset(2,0).value ="EEE"
Hope this is of some help.
At the moment I’m only able to copy&paste stuff from one row.
I use the code below:
Dim lastRow As Long
With Sheets("Tab1")
If Application.WorksheetFunction.CountA(.Columns(3)) <> 0 Then
lastRow = .Cells(Rows.Count, "C").End(xlUp).Row + 1
Else
lastRow = 1
End If
Sheets("Tabelle2").Range("B85:S85").copy
.Range("C" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End With
My problem is that I need to copy and paste lists. Can someone show me how to use this code to copy&paste lists?
I wanted to copy more rows, like (A25:S25, A27:S27, A30:S30)
It should copy always the same rows.
There are two reasons for your code copying just one row:
The code selects just one row to copy
Sheets("Tabelle2").Range("B85:S85").Copy
The select just on row to Paste
.Range("C" & lastRow).PasteSpecial Paste:=xlPasteValues …
As it’s not clear if you want to copy several rows despite selecting just one or to copy that one row to several rows I’ll cover both options in order to give you an idea of what to do in both cases:
Setting the range to be copied
a. To copy just range B85:S85 one row only then what you are doing is correct
Wbk.Sheets("Tabelle2").Range("B85:S85")
b. To copy X rows down from row 85 (including row 85)
Wbk.Sheets("Tabelle2").Range("B85:S85").Resize(X)
c. To copy Y rows up from row 85 (including row 85)
Wbk.Sheets("Tabelle2").Range("B85:S85").Offset(1-Y, 0).Resize(Y)
d. To copy the range bounded by any combination of blank rows and blank columns in which "B85:S85" is included (see Range.CurrentRegion Property (Excel))
Wbk.Sheets("Tabelle2").Range("B85:S85").CurrentRegion
Note that this will include also any rows above and below row 85 if they have at least one cell not blank that causes the "current region" to extend upwards or downwards and it will also include any columns to the left of columns B or to the right of column S if they have at least one cell not blank that causes the "current region" to extend sideways
This procedure demonstrates the options explained above:
Sub Range_Set()
Dim rSrc As Range
With ThisWorkbook.Sheets("Tabelle2")
'If want to copy just this row 85
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85")
rSrc.Select: Stop
'If want to copy 5 rows down from row 85 (including row 85)
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85").Resize(5)
rSrc.Select: Stop
'If want to copy 5 rows up from row 85 (including row 85)
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85").Offset(-4, 0).Resize(5)
rSrc.Select: Stop
'If want to copy then range bounded by any combination of blank rows and blank columns in which "B85:S85" is included
'This will include also any rows above and below row 85 if they have at least one cell not blank that causes the "current region" to extend upwards or downwards
'Also will include also any columns to the left of columns B or to the right of column S if they have at least one cell not blank that causes the "current region" to extend sideways
Application.Goto .Cells(1), 1
Set rSrc = .Range("B85:S85").CurrentRegion
rSrc.Select: Stop
End With
End Sub
Setting the range where the copy takes place
To copy the source range as it is, then just need to select the first cell of your target range and the paste.special will cover paste the target to all cells required as per the size all target cell. However is you want to copy range B85:S85’ to several cell then you need to select the target rows. For example if we want to copyB85:S85’ over five rows starting at C5 then we need to set the target range as
.Range("C12").Resize(5).PasteSpecial Paste:=xlPasteValues
As we are going to copy only the values of the source, I suggest to use the Range.Value property of the Range object instead of the Copy…Paste method. One advantage of using this property is to avoid the use of the Clipboard.
Try this code (select\adjust the options as per your requirements)
Sub Range_Value()
Dim Wbk As Workbook
Dim lastRow As Long
Dim rSrc As Range
Rem Declare Objects
Set Wbk = ThisWorkbook 'use this if procedure is resident in the wbk with the tables
'Set Wbk = Workbooks(WbkName) 'use this if procedure is not resident in the wbk with the tables - update wbk name
With Wbk.Sheets("Tab1")
lastRow = .Cells(.Rows.Count, "C").End(xlUp).Row
Rem Set Copy Range
'since we are going to paste only values then we can save us from using the clippboard
'Sheets("Tabelle2").Range("B85:S85").Copy
'instaed create a range to replace the values of the target range with the values of this range
'Uncomment\Update the option needed according to you requirements
'for this test I'm using option b
'a. To copy just row 85
'Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85")
'b. To copy X rows down from row 85 (including row 85) X=5
Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85").Resize(5)
'c. To copy 5 rows up from row 85 (including row 85) Y=5
'Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85").Offset(-4, 0).Resize(5)
'd. To copy the range bounded by any combination of blank rows and blank columns in which "B85:S85" is included
'This will include also any rows above and below row 85 if they have at least one cell not blank that causes the "current region" to extend upwards or downwards
'Also will include also any columns to the left of columns B or to the right of column S if they have at least one cell not blank that causes the "current region" to extend sideways
'Set rSrc = Wbk.Sheets("Tabelle2").Range("B85:S85").CurrentRegion
' As mentioned before we won't use the clipboard
'instead we replace the values with the values of the target range created earlier
'however we need to extend the range to the same size of the source range
.Range("C" & lastRow + 1).Resize(rSrc.Rows.Count, rSrc.Columns.Count).Value = rSrc.Value2
End With
End Sub
Hope this is clear enough and helps you to make progress with you coding, nevertheless let me know of any questions you might have.
I'm not quite sure what you're looking for - but here' how to loop:
Sub test()
For i = 25 to 30
Range(Cells(i,1),Cells(i,19)).Copy
Range(Cells(i,20),Cells(i,39)).PasteSpecial xlPasteValues
Next i
End Sub
That copies A25:S25 and pastes to T25:AM25...Then A26:S26, pastes T26:AM26, etc. until row 31.
Well now that the requirements are disclosed, we have the opportunity to apply another method. Bear in mind that the fact that the source range contains multiple areas may give us the idea of series of repetitive "copy paste values" which makes the undesirable use of the clipboard, or a repetitive Range Values.
This time instead of setting the source range as an object (which still can be done) we'll use an Array variable to grab the values of the multi-areas range
to later enter them in the target range as a unified and continuous range in one step.
This procedure sets an array with the values of the source range areas and then sets the values of the array to the target range using the Range.Value property.
Sub Range_MultiAreas_CopyValue()
Const kRowIni As Long = 25
Dim Wbk As Workbook
Dim aRngSrc() As Variant
Dim lRowLst As Long, l As Long, b As Byte
Rem Declare Objects
Set Wbk = ThisWorkbook
Rem Set Array with rows to copy as value
With Wbk.Sheets("Tabelle2")
l = kRowIni
For b = 1 To 30
If .Range("V" & l).Value2 = 0 Then
Rem Resize Array
On Error Resume Next
ReDim Preserve aRngSrc(1 + UBound(aRngSrc))
If Err.Number <> 0 Then ReDim Preserve aRngSrc(1)
On Error GoTo 0
Rem Set Row Values In Array
aRngSrc(UBound(aRngSrc)) = .Cells(l, 2).Resize(, 16).Value2
Rem Increase Row Pointer
l = l + 2
End If: Next: End With
Rem Reset Arrays Structure
With WorksheetFunction
aRngSrc = .Transpose(.Transpose(aRngSrc))
End With
Rem Let Array Values in Target Range
With Wbk.Sheets("Tab1")
lRowLst = .Cells(.Rows.Count, 1).End(xlUp).Row
lRowLst = IIf(.Cells(1, 1) = Empty, 1, lRowLst + 1)
.Cells(lRowLst, 1).Resize(UBound(aRngSrc, 1), UBound(aRngSrc, 2)).Value = aRngSrc
End With
End Sub
Once again let me know of any question you might have about the resources used.
As it is not possible to Copy more than one row at once when gaps are between as siddharth rout said we tried to bypass the problem with looping through every signle row which should be copiedand added an if query.
This code is working and i am using "him" now
j = 0
For i = 1 To 30
With Sheets("Arbeiter-Tage")
If Application.WorksheetFunction.CountA(.Columns(1)) <> 0 Then
lastRow = .Cells(Rows.Count, "A").End(xlUp).Row + 1
Else
lastRow = 1
End If
Sheets("Vorlage").Activate
If ActiveSheet.Range("V" & 25 + j).Value = 0 Then
ActiveSheet.Range("B" & 25 + j & ":" & "Q" & 25 + j).Copy
.Range("A" & lastRow).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End If
End With
j = j + 2
I've got a workbook with 9 different worksheets in which 1 of the sheets if 4 of them combined into 1 sheet for further comparison which from a copy and paste point of view is easy but im looking at it from an automation point of view as the length of rows can increase and decrease depending on data.
i need sheet A to copy in first on the left hand side on columns A,B,C which is then followed by sheet B which is inserted directly below sheet a on the same columns. Sheets C and D are similar but on the right of the first 2 sheets in columns H,I,J so they can be compared
I've tried to be clever and run multiple for loops on each sheet copying the data over to this work sheet with A&B sharing a global variable and C&D holding another so they went into the right places. Issue i had with this is long running times and mainly crashing on excel.
i also tried copying an pasting all the columns but didn't work as they vary in length so cant be recorded.
I finally tried a way of setting an row counter to be the last used row of the previous sheet to work but it also resulted in crashing.
Sheets("Income").Select
Dim xell As Range
For Each xell In Range("A1:A3005")
If Not xell.Value = "" Then
xell.EntireRow.Copy
Sheets("Workings").Select
Cells(z, "A").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=True, Transpose:=False
Sheets("Income").Select
z = z + 1
End If
Next xell
This is an example of my first attempt with the other sheets code being similar anyone got an idea of how to copy 4 work sheets into 1 in the desired destinations>?
Some things:
First, stop using Sheets().Select. There is no need, it will just flicker madly. You can safely use Sheets("Workings").Cells(...) to reference Cells on a Sheet.
Second, Cells() takes only integers as parameters, not "A". At best, this will be converted to 65 (ASCII) which is wrong for your case. Use Cells(z, 1) instead of Cells(z, "A").
Third, z needs to start at 1, not 0. You didnt initialize it anywhere so it will start as 0, which crashes.
You could try this:
Sub CopyIt()
allSheets = Array(Array(sheets("A"), sheets("B")), Array(sheets("C"), sheets("D")))
Set destSheet = sheets("Dest")
Set startRange = destSheet.Range("A1")
For Each doubleSheet In allSheets
For Each srcSheet In doubleSheet
Set firstEmpty = srcSheet.Columns(1).Find("")
If Not firstEmpty Is Nothing Then
RowCount = srcSheet.Columns(1).Find("").Row - 1
Range(srcSheet.Cells(1, 1), srcSheet.Cells(RowCount, 3)).Copy Destination:=startRange
Set startRange = startRange.Offset(RowCount, 0)
End If
Next
Set startRange = destSheet.Range("H1")
Next
End Sub
I'm working with an excel book containing a large number of sheets; the first sheet is linked to an external program and pulls in data via an external function, and the number of lines imported varies significantly.
This block data is the disseminated over a number of subsequent sheets. The first step has been to populate column A (row name) with the number of rows in sheet 1. From here the data is split over a number of columns (currently B->L). The top row uses an IF() function to populate the first row, and I'm looking to write a clean macro to copy this formula to row x (which varies with each data import refresh) and then paste values for a manageable file size.
Here's what I've got so far; it works, but it's fairly (read: VERY!) clumsy:
Sub Refresh_Data()
Sheets("Sheet2").Select
ActiveWindow.ScrollWorkbookTabs Sheets:=13
Sheets(Array("Sheet2" ... "Sheet25")).Select
Sheets("Sheet2").Activate
Sheets("Sheet25").Select Replace:=False
Range("B1:L1").Select
Selection.Copy
Range("__B2:B1000__").Select
ActiveSheet.Paste
Application.Calculate
ActiveWindow.ScrollWorkbookTabs Position:=xlFirst
Sheets(Array("Sheet2" ... "Sheet25")).Select
Sheets("Sheet2").Activate
Sheets("Sheet25").Select Replace:=False
Sheets("Sheet2").Select
Range("B3").Select
Sheets(Array("Sheet2" ... "Sheet25")).Select
Sheets("Sheet2").Activate
Sheets("Sheet25").Select Replace:=False
Range("B3:L4").Select
Range("__B2:L1000__").Select
Application.CutCopyMode = False
Selection.Copy
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Sheets("Check_sheet").Select
MsgBox "Update complete"
End Sub`
The main thing I'm looking to achieve is to replace the code B2:L1000 with something that can assess the number of rows in column A and select a range in rows B to L accordingly.
Since column L is the last populated column, I don't see why this can't also be done horizontally rather than defining "B:L" incase future columns need to be added.
Although the earlier answer has merits:
1) I would not use COUNTA because if there are empty cells in the row or column, the cells at the bottom or the right will be ignored.
2) I would never rely on the user picking the correct sheet to be used before running a macro; particularly one with so many sheets.
My reaction to the question is that you have set Macro Record, wandered around your workbook and then stopped the record. You select one thing, then another. You scroll through the sheets. To me most of the statements are not clumsy they are pointless.
The following does include an answer to your question about finding the last row of column A but it is more a tutorial about finding the dimensions of a range, getting data out of the range and then putting it somewhere else. This seems to be most of what you are trying to do with the most minimal understanding of VBA. I am sorry if this criticism is unfair but that is the impression your question gives to me.
Sub Test()
Dim RowS01Max As Integer
Dim Sheet1Data() As Variant
' With Sheets("Sheet1") allows you to access data within worksheet Sheet1
' without selecting it.
' Range("A1:C11") refers to a range within the active sheet
' .Range("A1:C11") refers to a range within the sheet identified in the
' With statement.
' ^ Note the dot
With Sheets("Sheet1")
' Rows.Count is the number of rows for the version of Excel you are using.
' .Cells(Rows.Count, "A") address the bottom row of column A of worksheet
' Sheet1.
' .Cells(Rows.Count, 1) refer to column A by number.
' End(xlUp) is the VBA equivalent of Ctrl+Up.
' If you positioned the cursor at the bottom of column A and pressed
' Ctrl+Up, the cursor would jump to the last row in column A with a value.
' The following statement gets that row number without actually moving
' the cursor.
RowS01Max = .Cells(Rows.Count, "A").End(xlUp)
' The following statement loads the contents of range A1:C11 of
' Sheets("Sheet1") into array Sheet1Data.
Sheet1Data = .Range("A1:C11").Value
' This is the same statement but the range is specified in a different way.
' .Cells(Row,Column) identifies a single cell within the sheet specified in
' the With statement. .Cells(1,1) identifies row 1, column 1 which is A1.
'. Cells(11, "C") identifies row 11, column C which is C11.
Sheet1Data = .Range(.Cells(1, 1), .Cells(11, "C")).Value
' This statement uses RowS01Max to specify the last row
Sheet1Data = .Range(.Cells(1, 1), .Cells(RowS01Max, 1)).Value
' In all three examples above, the contents of the specified range will
' be loaded to array Sheet1Data. Whichever range you pick, Sheet1Data
' will always be a two dimensional array with the first dimension being
' the row and the second dimension being the column.
' In the first two examples Sheet1Data(5,3) contains the contents
' of cell C5. In the third example, I have only loaded column A but the
' array will still has two dimensions but the only permitted value for the
' second dimension is 1.
' The following statement writes the contents of Sheet1Data to column "E"
.Range(.Cells(1, 5), .Cells(RowS01Max, 5)).Value = Sheet1Data
End With
With Sheets("Sheet2")
' The following statement writes the contents of Sheet1Data to column "E"
' of worksheet Sheet2.
.Range(.Cells(1, 5), .Cells(RowS01Max, 5)).Value = Sheet1Data
End With
End Sub
Don't despair! Most of us started with the macro recorder and still use it to discover the syntax for an unfamiliar command. Look through other questions. Some ask about exotic functionality but many are about moving data around in, to the experienced programmer, simple ways. Set up some workbooks with the questioner's problem. Copy and paste the solution into a module. Step through it using F8 (see the debugger), switch between Excel and Editor, watch what is happening to the worksheet and move the cursor over a variable to see its current value. Spend half a day playing. You will be amazed at how quickly it starts to make sense. Good luck and good programming.
The following should do the trick:
Sub Refresh_Data()
Dim lastRow As Integer
Dim lastCol As Integer
Dim entireRange As Range
Dim targetRange As Range
lastRow = Excel.Evaluate("COUNTA(A:A)") ''// count the rows in column A
lastCol = Excel.Evaluate("COUNTA(1:1)") ''// count the columns in row 1
Set entireRange = Range(Cells(1, 2), Cells(lastRow, lastCol))
Set targetRange = Range(Cells(2, 2), Cells(lastRow, lastCol))
entireRange.FillDown
Application.Calculate
targetRange.Copy
targetRange.PasteSpecial Paste:=xlPasteValues
End Sub
Notes:
Excel.Evaluate(...) allows you to use the result of worksheet functions in your VBA macros.
COUNTA(range) is a worksheet function that counts the number of non-blank cells in a given range. In this case, it can be used to determine the total number of rows in your data set, as well as the number of columns in row 1 that have a formula in them.