I am trying to use a 'Do Until' loop to take a value from list (Drop-down fields worksheet, starting at cell B19) and update a cell value another Excel Sheet (specifically, Data Collection worksheet, cell C1). Once I can get this to work, I will add already functioning code to save the file based on the value in C1 in the Data Collection worksheet.
I am testing the code but it is constantly getting stuck after the pulling that first value. Basically, it doesn't actually loop through the list until it ends.
I believe it has to do with what is classified as the active cell. I think when I paste the value that changes the active cell. I tried to correct this by re-iterating the active cell again. This might be creating an infinite loop though.
Is there something I can do to adjust this? Thank you in advance for looking at this and any replies you might have! I based structure on the documentation found at https://learn.microsoft.com/en-us/office/troubleshoot/excel/loop-through-data-using-macro
Code below:
Sub Test2()
' Select cell to start loop, *first line of data*.
Worksheets("Drop-down fields").Activate
Range("B19").Select
Worksheets("Drop-down fields").Range("B19").Copy
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
Worksheets("Data Collection").Range("C1").PasteSpecial Paste:=xlPasteValues
Worksheets("Drop-down fields").Activate
Range("B19").Select
' Step down 1 row from present location.
ActiveCell.Offset(1, 0).Select
Loop
End Sub
Samuel,
Here's your code refactored to remove all the activates and selects and incrementing through you list in col B and copying to col C.
Sub Test2()
Dim wksSrc as Worksheet
Dim wksDst as Worksheet
Dim lSrcRow as Long
Dim lDstRow as Long
Set wksSrc = Worksheets("Drop-down fields")
Set wksDst = Worksheets("Data Collection")
lSrcRow = 19
lDstRow = 1
Do
wksSrc.cells(lSrcRow,2).Copy
wksDst.Cells(lDstRow,3).PasteSpecial Paste:=xlPasteValues
lSrcRow = lSrcRow + 1
lDstRow = lDstRow + 1
Loop Until wksSrc.cells(lSrcRow,lSrcCol) = ""
End Sub 'Test2
Note: code is untested but I think I got all the references right.
HTH
Related
This code is supposed to check if conditions in two certain columns are met and if they are it supposed to take a value from another sheet and paste it into the end of the row of the checked row to the source sheet. For testing purpose, I try to at least keep it at a specific range now. I think I know where I'm wrong, the cell. Value most likely and that the range is probably not working as I have imagined it in my mind. Also, it is probably not even looping through the columns. I have like 30 different cell possibilities to copy from for different conditions and I suppose I can adjust them each depending on the conditions, but need to make this first attempt to work, then it will be pancake day, or not..
Sub Update()
Dim Column As Range
Sheets("Q485").Select
Set Column = Range.Select("AV:AW")
If Column("AW") Is cell.Value("P") And Column("AV") Is cell.Value("V") Then
Sheets("Support").Select
Range("C9").Select
Selection.Copy
Sheets("Q485").Select
Range("AY6358").Select
Selection.Paste
' Else
' Other conditions will be written below
end if
End Sub
Testing, testing, testing, but would like some suggestions from experts
Sub MyMacroc ()
Dim rng as range
set rng = sheets("Source").range("A2:A7")
For Each cel In rng.Cells
with cel
'condition -1 '
if .offset(0,1)="P" and .Offset(0,2)="V" then
.offset(0,3) = Sheets("Extract").range("B2")
ElseIF
'your second conition
end if
end with
next
End sub
I am aware that there are many questions like this one in this forum. Yet, none of them gives satisfying reply.
I need a macro that will copy values from 3 cells from various sheets (all in the same Excel file): E6 (actually it is a merged cell containing columns EFG), E(FG)5 and E21. Then pastes those values into new sheet into columns A, B and C. There are 2 problems that do not let me solve this issue with traditional copy cell value code or answers in other threads in this forum:
There are 3 cells merged.
The number of worksheets might differ for different period of times, and they might change their names as well.
This is the code that I have found for another similar problem:
Sub CopyToMaster()
ShtCount = ActiveWorkbook.Sheets.Count
For i = 2 To ShtCount
Worksheets(i).Activate
Range("E6").Select
Selection.Copy
Sheets("Master").Activate
'Required after first paste to shift active cell down one
Do While Not IsEmpty(ActiveCell)
ActiveCell.Offset(1, 0).Select
Loop
ActiveCell.Offset(0, -3).Select
Selection.PasteSpecial
Next i
End Sub
Source Data (This is source data, I where I marked with yellow 3 cells that values, I need to copy):
Needed result (Here is the expected outcome, where each from previous yellow marked cells should be pasted in respective column):
Thx for your help.
Please, test the next (working) code. It should be faster than yours, not using clipboard. You must know that the value of a merged range is kept in its top left cell. So, having ranges with a single row, it is enough to try extracting the value of the first marge cells cell:
Sub CopyToMasterWorking()
Dim ws As Worksheet, wsM As Worksheet, lastR As Long, i As Long
Set wsM = Worksheets("Master")
wsM.UsedRange.Resize(wsM.UsedRange.rows.count - 1).Offset(1).ClearContents 'clear everything, except headers
For Each ws In ActiveWorkbook.Worksheets
If ws.name <> wsM.name Then
lastR = wsM.UsedRange.SpecialCells(xlCellTypeLastCell).row + 1
wsM.Range("A" & lastR).Value = ws.Range("E6").Value
wsM.Range("B" & lastR).Value = ws.Range("E5").Value
wsM.Range("C" & lastR).Value = ws.Range("E21").Value
wsM.Range("D" & lastR).Value = ws.name 'you may comment this line if not necessary...
End If
Next ws
End Sub
I thought that it would be good to have a little traceability, I mean to know from which sheet the data comes (per row). If you do not need it, you may comment last code line from iteration between sheets.
The code also clear everything in "Master" sheet, except the header, before starting processing. If you need to add at the end of existing data, you have to comment that line, too.
Please, send some feedback after testing it. If something not clear enough, do not hesitate to ask for clarification...
I think your only problem is copying merged-cell ranges, correct? This shows how to copy a merged-cell range to 1) same-sized range 2) single cell 3) different-sized range:
Option Explicit
Sub sub1()
Dim variant1
Cells.Delete
' define a merged-cell range and populate:
Range("b2:c3").MergeCells = True
Range("b2:c3") = " B2:C3 "
' to copy to a like-sized merged-cell range:
Range("b5:c6").MergeCells = True
Range("b2:c3").Copy Range("b5:c6")
' to copy to a single cell
variant1 = Range("b2:c3").Value
Range("b8").Value = variant1
' to copy to a different-sized merged-cell range:
Range("b10:d12").MergeCells = True
variant1 = Range("b2:c3").Value
Range("b10:d12").Value = variant1
End Sub
I am trying to copy multiple columns from multiple worksheets into a new worksheet in Excel using a VBA Macro.
I have already created the worksheet, and I want to paste specific columns one after another in that worksheet.
I would like to copy from each worksheet all columns including and beyond a certain column, in all worksheets including and from Column F.
I have written a piece of code that selects the appropriate data and loops correctly.
However, i get a "run-time error 1004", when the loop hits a worksheet where I am copying only one column.
I know this is because of the choice of my code. However, I don't know how to solve the problem.
The problem is that my code selects a range to the end of the worksheet when there is only one column being selected. This creates a copied area too big to paste in the new worksheet.
Dim i As Integer
i = 1
Do While i <= Worksheets.Count - 1
Worksheets(i).Select
'Select, Copy and Paste Data
RangeFromF1
Selection.Copy
Worksheets("Combined").Select
Range("X1").Select
Selection.End(xlToLeft).Select
ActiveCell.Offset(0, 1).Select
ActiveSheet.Paste
i = i + 1
Loop
End Sub
Public Sub RangeFromF1()
Range("F1", Range("F1").End(xlDown).End(xlToRight)).Select
End Sub
Instead of going from column F to the right, try going from the last column to the left.
Public Sub RangeFromF1()
Range("F1", Cells(1, Columns.Count).End(xlToLeft).End(xlDown)).Select
End Sub
You might also want to get rid of all the Select stuff.
Sub CopyStuff()
Dim i As Long
i = 1
Do While i <= Worksheets.Count - 1
With Worksheets(i)
.Range("F1", .Cells(1, .Columns.Count).End(xlToLeft).End(xlDown)).Copy
Worksheets("Combined").Cells(1, Columns.Count).End(xlToLeft).Offset(, 1).Paste
i = i + 1
End With
Loop
End Sub
Before coming back to check for your answer noris, I figured out a way, to do as you suggested, with the following code:
Public Sub ReferenceSelection()
Dim startcell As Range
Set startcell = Range("A1").End(xlDown).End(xlToRight)
Range(startcell, ("F1")).Select
End Sub
I have a list of names, and some code that I would like to run for every single name.
What I'm starting with is this:
Dim cell As Range
For Each cell In Worksheets("Reference").Range("b2:b237")
[rest of my code here]
Next cell
The issue is, what I'm actually trying to do is:
Step 1) Select a name from a drop down list in cell A1
Step 2) There are a bunch of other cells with formulas that reference A1
Step 3) Run code
Step 4) Select next name from drop down list in A1, repeat Steps 2 & 3, until end of list.
Edit: I found something on an old thread that seems to work for what I'm doing:
Sub Macro1()
Sheets("Sheet2").Activate
Range("A1").Select
Do While True
If Selection.Value = "" Then
Exit Do
Else
Selection.Copy
Sheets("Sheet1").Activate
Range("A1").Activate
ActiveSheet.Paste
[rest of my code]
Sheets("Sheet2").Activate
Selection.Offset(1, 0).Select
End If
Loop
End Sub
This should do the job, but if anyone has a more efficient way rather than copying and pasting each value from the list to the cell, that would be very helpful too!
Thank you.
This will take each name in a range and put it into a cell sequentially - you will need to edit to put your sheetnames and ranges in
Sub LoopThroughNames()
dim RangeWithNames as range
'define list of names - needs editing
set RangeWithNames = Worksheets("othersheetname").Range("range with names")
dim TargetCell as range
set TargetCell = worksheets("Sheet with calcs").Range("A1") 'top sheet, cell A1 edit as needed
dim r as range
for each r in RangeWithNames
targetcell= r 'assign name into A1
'do your stuff
next r
End Sub
I've created a loop where I want it to continue to loop until the active cell is empty. If the active cell is not empty I want it to copy the contents of cell "C2" (from a different sheet) into cell "D5".
The Active Cell range is "G5" and the destination is "D5" I want both to offset so check "G6" and paste to "D6".
And so on until the Active Cell("G6" in this example) is empty and stop the loop.
I have provided some code which should help with what ive tried to explain above. I just want the loop to check the Active Cell is not empty and then paste the contents to the destination. Most basic terms every time it loops I want the "D5" to change to D6".
Sub FormatFile_Click()
Dim raw As Worksheet
Dim formula As Worksheet
Set raw = ThisWorkbook.Worksheets("Raw")
Set formula = ThisWorkbook.Worksheets("Formula")
Range("G5").Select
' Set Do loop to stop when an empty cell is reached.
Do Until IsEmpty(ActiveCell)
formula.Range("C2").Copy Destination:=raw.Range("D5")
ActiveCell.Offset(1, 0).Select
Loop
End sub
Something like this should do the Job for You.
Sub FormatFile_Click()
Dim raw As Worksheet
Dim formula As Worksheet
Dim i As Integer
Set raw = ThisWorkbook.Worksheets("Raw")
Set formula = ThisWorkbook.Worksheets("Formula")
For i = 5 To raw.Range("G5:G" & raw.Range("G5").End(xlDown).Row).Cells.Count + 5
formula.Range("C2").Copy Destination:=raw.Cells(i, 4)
Next
End Sub
Always try to avoid usage of Select & Activate in VBA
You could skip the loop and go much faster with something like this: (untested)
dim fla as string
fla = worksheets("formula").range("c2").formulaR1C1
worksheets("raw").range("G5:G60000").Specialcells(xlCellTypeConstants).formulaR1C1 = fla
Unfortunately using While or Until with range is a bit complicated. I would suggest using the following:
Dim raw As Worksheet
Dim formulaSht As Worksheet
Dim i as Long
dim Idest as Long
Set raw = ThisWorkbook.Worksheets("Raw")
(I changed the worksheet formula to FormulaSht just to make differentiate it from the formula command)
Set formulaSht = ThisWorkbook.Worksheets("Formula")
'instead of selecting the range define it in the loop!
' g5 is cells(5,7)
' Range("G5").Select
i = 5
'I'm setting the destination row as 2 ii (feel free to change it, also you can modify the 'column number, for the below I'll match column d = 4, if you want the copied row to be the same as the pasted row than you can use the same variable for both as save the tiniest bit of memory
Idest = 2
' Set Do loop to stop when an empty cell is reached.
Do Until Cells(i,7) = ""
formulaSht.cells(i,7).Copy Destination:=raw.cells(Idest,4)
i = i+1
Idest = Idest + 1
Loop
End sub