I have a set of information in the same column (H27:O27) in one sheet ("P1-FR1") and would like to paste individual values to another sheet (AQ6:AX6) ("Übersicht GESAMT")
I'm trying to use a For loop but the values just copy one after the other (in the same cell) instead of copying one in each cell. This is my code:
Sub CopyValues()
Dim i As Long
Dim j As Long
Dim Wert As Long
For i = 8 To 14
Wert = Sheets("P1-FR1").Cells(27, i)
For j = 43 To 50
Sheets("Übersicht GESAMT").Cells(6, j) = Wert
Next j
Next i
End Sub
You don't need a double For loop in this case at all. A simple .Value copy will work. The code below shows two examples with different ways to accomplish what you want. (TIP: it always helps me to be VERY clear on how I name the variables, it helps to keep track of where all the data is coming and going)
Option Explicit
Sub CopyTheValues()
Dim datenQuelle As Range
Dim datenZiel As Range
Set datenQuelle = ThisWorkbook.Sheets("P1-FR1").Range("H27:O27")
Set datenZiel = ThisWorkbook.Sheets("Übersicht GESAMT").Range("AQ6:AX6")
'--- method 1 - works because the ranges are the same size and shape
datenZiel.Value = datenQuelle.Value
'--- method 2 - for loops
' index starts at 1 because the Range is defined above
' (and we don't care what rows/columns are used)
Dim j As Long
For j = 1 To datenQuelle.Columns.Count
datenZiel.Cells(1, j).Value = datenQuelle.Cells(1, j).Value
Next i
End Sub
Copying By Assignment
Option Explicit
Sub CopyValuesNoLoop()
ThisWorkbook.Worksheets("Übersicht GESAMT").Range("AQ6:AX6").Value _
= ThisWorkbook.Worksheets("P1-FR1").Range("H27:O27").Value
End Sub
Sub CopyValuesQuickFix()
Dim j As Long: j = 43
Dim i As Long
For i = 8 To 14
ThisWorkbook.Worksheets("Übersicht GESAMT").Cells(6, j).Value _
= ThisWorkbook.Worksheets("P1-FR1").Cells(27, i).Value
j = j + 1
Next i
End Sub
The nesting of the for loops is causing your issue. It is causing each cell from the first sheet to be copied to all cells on the second sheet.
You only need one loop to perform the copy. Something like this should work.
Sub CopyValues()
Dim i As Long
For i = 8 To 15
Sheets("Übersicht GESAMT").Cells(6,i+35) = Sheets("P1-FR1").Cells(27,i)
Next i
End Sub
Related
I have written a short VBA code to copy rows from one worksheet "Quote Tracker", to another sheet "Cashflow", once a certain value has been selected in Column "O" (75 - 100%).
The issue I am having is that the rows are not copied into the next available empty row, only further down the sheet. I am also unable to stop the code copying the same line multiple times.
Is there anything I can add to ensure they are always added to the top of the "Cashflow" sheet or next available row?
I am also unable to put anything together to detect duplicates, so if the code is run more than once, it just keeps adding them to the "Cashflow sheet". Can anything be added to stop this?
Here is what I have so far:
Sub MoveRowBasedOnCellValue()
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = Worksheets("Quote Tracker").UsedRange.Rows.Count
J = Worksheets("Cashflow").UsedRange.Rows.Count
If J = 1 Then
If Application.WorksheetFunction.CountA(Worksheets("Cashflow").UsedRange) = 0 Then J = 0
End If
Set xRg = Worksheets("Quote Tracker").Range("O1:O" & I)
On Error Resume Next
Application.ScreenUpdating = False
For K = 1 To xRg.Count
If CStr(xRg(K).Value) = "75 - 100%" Then
xRg(K).EntireRow.Copy Destination:=Worksheets("Cashflow").Range("A" & J + 1)
J = J + 1
End If
Next
Application.ScreenUpdating = True
MsgBox "Jobs copied to Cashflow tab"
End Sub
If you require more information, please, just let me know. I'm new here and trying to make a good impression.
I have compiled a sub that will suit your needs. The first issue I saw was your use of "On Error resume Next". This will make it nearly impossible to debug your code because the code will not tell you if there is an error it will simply skip over it. The second issue I was able to see was that you made the problem more complex than necessary. You used a For To loop where a For Each loop would get the job done more easily. I have added in a piece of code which makes the cell in the "P" column of the row with a value over 75% "Transferred" once it has been copied to the "Cashflow" sheet. The code also checks if "Transferred" is present in that column and if it is, it skips that value. Additionally, the code checks if J is 1 which would be the first value copied, and if it is not one then it adds one to the counter so that it does not paste on top of the row above.
Sub MoveRowBasedOnCellValue()
Dim QTWs As Worksheet
Dim CWs As Worksheet
Set QTWs = Worksheets("Quote Tracker")
Set CWs = Worksheets("Cashflow")
Dim xRg As Range
Dim xCell As Range
Dim I As Long
Dim J As Long
Dim K As Long
I = QTWs.UsedRange.Rows.Count
J = CWs.Cells(Rows.Count, "O").End(xlUp).Row
If J <> 1 Then
J = J + 1
End If
Set xRg = QTWs.Range("O1:O" & I)
Application.ScreenUpdating = False
For Each c In xRg
K = c.Row
If c.Value < 0.75 Then
'Do Nothing
Else
If QTWs.Cells(K, 16) <> "Transferred" Then
QTWs.Rows(K).Copy Destination:=Worksheets("Cashflow").Range("A" & J)
QTWs.Cells(K, 16).Value = "Transferred"
J = J + 1
Else
'Do Nothing
End If
End If
Next
Application.ScreenUpdating = True
MsgBox "Jobs copied to Cashflow tab"
End Sub
If you have questions about how it works, do not hesitate to let me know. Hope this helps!
I want to count how many times appear the parameters CA, CU and CH, in an excel that looks like this:
I have tried to use the following code, but as the cells don't contain only the parameter I am searching for, it doesn't work:
Sub ContarOV()
Dim cont As Variant
Dim sumaCA As Variant
Dim sumaCU As Variant
Dim sumaCH As Variant
sumaCA = 0
sumaCU = 0
sumaCH = 0
For cont = 3 To 12
If Cells(cont, 2) = ("CA") Then
sumaCA = sumaCA + 1
End If
If Cells(cont, 2) = ("CU") Then
sumaCU = sumaCU + 1
End If
If Cells(cont, 2) = ("CH") Then
sumaCH = sumaCH + 1
End If
Next cont
End Sub
As per #BigBen, I would try to avoid any iteration. What about one of the following options (assuming your data sits from A2:A?):
Sub Test()
Dim lr As Long, x As Long
Dim arr As Variant
Dim rng As Range
With Sheet1 'Change according to your sheets CodeName
'Get last used row
lr = .Cells(.Rows.Count, 1).End(xlUp).Row
'Get data into memory for method 1
arr = Application.Transpose(.Range("A2:A" & lr).Value)
'Create range object for method 2
Set rng = .Range("A2:A" & lr)
'Method 1: Count values with FILTER
Debug.Print UBound(Filter(arr, "CA")) + 1
Debug.Print UBound(Filter(arr, "CU")) + 1
Debug.Print UBound(Filter(arr, "CH")) + 1
'Method 2: Count values with COUNTIF
Debug.Print WorksheetFunction.CountIf(rng, "CA*")
Debug.Print WorksheetFunction.CountIf(rng, "CU*")
Debug.Print WorksheetFunction.CountIf(rng, "CH*")
End With
End Sub
Btw, I would give sumaCA and your other variables a meaningfull data type, Long in this case.
You can use InStr() to return the position of the desired characters in the string. This would look something like If Not InStr(1, Cells(cont,2).Text, "CH") = 0 Then, but looping through strings is generally a slow process. Unless you have a specific need for looping, I like BigBen's answer a lot better than I like looping with InStr().
My code is really simple:
Dim j As Long
Dim k As Long
k = 2
For i = 0 To PatientList.ListCount - 1
If PatientList.Selected(i) = True Then
Worksheets("Print").Range("B" & k).Value = 1
k = k + 1
End If
Next i
Unload Me
For some reason, if I remove the line that contains (Worksheets.......) and have a multiselected listBox the k variable is incremented normally and all is fine.
If I add the aforementioned line, the program goes through the cycle once as if only one line on the listbox is selected. The k variable is not incremented and setting toggle shows that the program doesn't not recognize the multiselection, but only the first choice.
Any ideas?
This is very odd and I tested on different PCs....
since it seems your ListBox RowSource value is influenced by any change of "Print" worksheet, you could collect the range to be copied/pasted and do the copy/paste operation at the end
Dim i As Long
Dim k As Long
k = 2
Dim rngToBeCopied As Range ' range to collect cells to copy
For i = 0 To PatientList.ListCount - 1
If PatientList.Selected(i) = True Then
' update range to be copied
If rngToBeCopied Is Nothing Then
Set rngToBeCopied = Worksheets("Source").Cells(k, 1)
Else
Set rngToBeCopied = Union(rngToBeCopied, Worksheets("Source").Cells(k, 1))
End If
k = k + 1
End If
Next i
' if any range to copy, then paste it to "Print" worksheet
If Not rngToBeCopied Is Nothing Then rngToBeCopied.Copy Worksheets("Print").Range("B1").Resize(rngToBeCopied.Count)
Me.Hide ' hide UserForm
' Unload Me ' move 'Unload' statement in the sub that has created/shown the Userform
just change Worksheets("Source").Cells(k, 1) to the proper sheet and range reference you actualy need
I have problem on swapping Column A to Column B then Column B to Column A, both column has row count of 2563. Is there any vba code to solve this problem?
I'm Already trying this code:
Private Sub CommandButton1_Click()
Dim temp As Double
temp = Range("A1").Value
Range("A1").Value = Range("B1").Value
Range("B1").Value = temp
End Sub
But it can only swap row 1 of both columns...
You can swap them all by a loop. For your case, the loop should go for 2563 times.
Private Sub CommandButton1_Click()
For i = 1 To 2563
temp = Cells(i, 1).Value
Cells(i, 1).Value = Cells(i, 2).Value
Cells(i, 2).Value = temp
Next i
End Sub
Using an array would be much faster than looping. In this example column A is copied into an array Hold_RNG. Then Column B is copied to column A, and then the Array is copied into Column B.
Sub SwapCOlumns()
Dim hold_rng() As Variant
Dim rowsToinclude As Long, WS As Worksheet
Set WS = ActiveSheet '<--- make sure this is correct worksheet
rowsToinclude = 2563 '<----- might want to make more dynamic
With WS
hold_rng = .Range("A1:A" & rowsToinclude)
.Range("A1:A" & rowsToinclude).Value = .Range("B1:B" & rowsToinclude).Value
.Range("B1:B" & rowsToinclude).Value = hold_rng
End With
End Sub
Updated: I don't mean to pick on the competing answer as it's simple and effective, but our two answers offer a good illustration of why using Arrays to impact a spreadsheet all at once, is much more efficient than looping and editing. I built this code which will time the results of each approach (inserting in Column E) of a spreadsheet. Through one round of 2563 rows the score was 0 seconds to 4. The array continued to output in 0 seconds while the loop approach fell to 41 seconds when doing 9 trials.
Screen Shot Of Results.
Timing code can be found on my PasteBin page (I don't want this answer to look ridiculously long)
I prefer to use arrays because is much faster.
Option Explicit
Sub test()
Dim i As Long
Dim arrA As Variant, arrB As Variant
Dim ValueA As Double, ValueB As Double
'Cahng if needed
With ThisWorkbook.Worksheets("Sheet1")
arrA = .Range("A1:A2563")
arrB = .Range("B1:B2563")
For i = 1 To 2563
ValueA = arrA(i, 1)
ValueB = arrB(i, 1)
arrA(i, 1) = ValueB
arrB(i, 1) = ValueA
Next i
.Range("A1").Resize(UBound(arrA), 1) = arrA
.Range("B1").Resize(UBound(arrB), 1) = arrB
End With
End Sub
Just to add it into the mix, there is a third way.
Insert a column after B. Copy A to C. Delete A.
With ThisWorkbook.Worksheets(1)
.Columns(3).Insert
.Columns(1).Copy .Columns(3)
.Columns(1).Delete
End With
(It assumes you want to move the whole column, but you normally would.)
However, the speed at which this will run depends upon the size of the worksheet and how many formulae it has.
Proper syntax Match and If not isblank
I need some assistance with creating a loop statement that will determine the range start and end where a particular criteria is met.
I found these statements on the web and need help to modify them to loop thru two different worksheets to update a value on 1 of the worksheets.
This one has an issue returning True or False value for the Range when I want to pass the actual named range for look up where this field = Y, then returns the value from another column. I original tried using Match and If is not blank function. But that is very limiting.
See the previous post to see what I am trying to accomplish - I know I will need to expand the code samples and probably will need help with this modification.
Sub Test3()
Dim x As Integer
Dim nName As String
Sheets("BalanceSheet").Select
nName = Range("qryDifference[[Validate Adjustment]]").Select
Debug.PrintnName
' Set numrows = number of rows of data.
NumRows = Range(nName, Range(nName).End(xlDown)).Rows.Count
' Select cell a1.
' Establish "For" loop to loop "numrows" number of times.
For x = 1 To NumRows
' Insert your code here.
MsgBox"Value found in cell " & ActiveCell.Address
' Selects cell down 1 row from active cell.
ActiveCell.Offset(1, 0).Select
Next
End Sub
This is what I have so far - this is giving me and issue with
ActiveCell.Offset(4, 0).Select
nAgentNo = Range("qryDifference[[agtno]]").Value
nValidate = Range("ryDifference[[Difference]]").Value
Debug.Print nAgentNo
Debug.Print nValidate
Type mismatch error on the above.
Sub Revised_AgentAmount()
Dim myRange As Range
Dim i As Long, j As Long
Dim nAgentNo As String
Dim nValidate As Long
Sheets("BalanceSheet").Select
Set myRange = Range("qryDifference[[Validate Adjustment]]")
For i = 1 To myRange.Rows.Count
For j = 1 To myRange.Columns.Count
If myRange(i, j).Value = "Y" Then
ActiveCell.Offset(4, 0).Select
nAgentNo = Range("qryDifference[[agtno]]").Value
nValidate = Range("ryDifference[[Difference]]").Value
Debug.Print nAgentNo
Debug.Print nValidate
End If
Next j
Next i
End Sub
In your first statement you declare nName as a String then try to select it. You would need to declare it as a Range if you are going to use it as a Range object.
I found solution elsewhere with a if statement instead of the for loop.
=IF([#agtno]=B24,[#[agt_amt]],SUMPRODUCT((Balance!$B$2:$B$7=[#agtno])*(Balance!$F$2:$F$7="Y")*Balance!$E$2:$E$7)+[#[agt_amt]])