So I'm trying to work on a single file, go to each cell in column A on "Source" (from row 1 to last row holding data), place that value in cell C3 on "Destination", recalculate the workbook and save the file
I haven't gotten to save the file yet because I am stuck on looping. Can anybody help please?
Sub test()
Sheets("Source").Select
With ActiveSheet
Set r = Range("Employee #")
For n = 1 To r.Rows.Count
r.Cells(n, 1).Select
Selection.Copy
End With
Sheets("Destination").Select
Range("C3").Select
ActiveSheet.Paste
Application.CutCopyMode = False
Next n
End Sub
Started VBA 7 days ago so I am trying to do my best here..
In further review you do not need the with block
Sub test()
with Sheets("Source")
Set r = .Range(.Range("A2"),.Range("A" &.row.count).end(xlup))'Change this to the column you want
end with
For n = 1 To r.Rows.count
r.Cells(n, 1).copy Sheets("Destination").Range("C3")
Application.CutCopyMode = False
Next n
End Sub
or all the slects for that matter. But now you can see that you are putting every value that you loop into one cell.
Related
i need a simple vba code. I hope someone can help me.
So, I want to copy the range B2:E6 and leave some cells marked with a special condition. I created a rule in cells A2:A6 with the value Y / X. In the end, I want to paste the value B2:E6 in the range F9:I13 only if the value is Y.
I am attaching the following image to make it easier for you to understand.
Any help will be great. And sorry my english is bad.
Maybe this can get you started
Sub Macro1()
Dest = 8
For Row = 1 To 6
If Cells(Row, 1) <> "x" Then
Range(Cells(Row, 2), Cells(Row, 5)).Select
Selection.Copy
Cells(Dest, 6).Select
ActiveSheet.Paste
End If
Dest = Dest + 1
Next Row
End Sub
I recommend that you first define your working worksheet, if the CommandButton1 button code linked to the CommandButton1_Click() event, showen in your code, is not associated with your working sheet (Sheet9). Otherwise, the code will be executed on another Sheet than Sheet9, on which you want the conditions to be fulfilled.
So, I suggest this code, that formats also the target table "(F8:I13)":
Private Sub CommandButton1_Click()
Dim myWorkingSheet As Worksheet
Dim Working_Range As Range, Target_Range As Range
Dim Line_to_Read As Double, Table_Shift As Double
Set myWorkingSheet = Sheets("Sheet9")
myWorkingSheet.Activate
' Copy the header table
myWorkingSheet.Range("B1:E1").Copy Range("F8")
Application.CutCopyMode = False
' Copy the format of the table
myWorkingSheet.Range("B1:E6").Copy
myWorkingSheet.Range("F8").PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
' Copy table if current cell in column A = "y"
Set Working_Range = myWorkingSheet.Range("A2:A6")
Line_to_Read = 2
Table_Shift = 7 'To start at F9 cell
For Each wr In Working_Range
If wr = "y" Then
myWorkingSheet.Range(Cells(Line_to_Read, 2), Cells(Line_to_Read, 5)).Copy myWorkingSheet.Range(Cells(Line_to_Read + Table_Shift, 6), Cells(Line_to_Read + Table_Shift, 10))
End If
Line_to_Read = Line_to_Read + 1
Next
' To point the cursor at the first cell.
myWorkingSheet.Cells(1, 1).Select
End Sub
To avoid the repetition of myWorkingSheet in the you use With clause and End With.
I need your help. I'm trying to run a macro on every row of a table. I want to have the first and the last interaction date with all clients of the list. What I already did on a macro is to copy the first date from a sheet2 and paste it on sheet1 to get the first date, then with CTRL-Down do it again with the next date to get the last date. However, since it's not a loop, it only does it on the cells I did it. (Down is the code I have). I would like the code to do the same thing on every cell, until the end of the table.
I have attached screenshot of the two sheets. I hope I made myself clear and I hope someone can help you out.
sheet1 sheet2
Sheets("Total").Select
Range("D6923").Select
Selection.End(xlDown).Select
Selection.Copy
Sheets("Timeline").Select
ActiveSheet.Paste
Range("C189").Select
Sheets("Total").Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Timeline").Select
ActiveSheet.Paste
Range("B190").Select
Sheets("Total").Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Timeline").Select
ActiveSheet.Paste
Range("C190").Select
Sheets("Total").Select
Selection.End(xlDown).Select
Application.CutCopyMode = False
Selection.Copy
Sheets("Timeline").Select
ActiveSheet.Paste
I can see you are very new to this and that is fine, we all were once! Using recorded macros is a good way to see how excel views what you are doing at the time but it is extremely inefficient compared to what it could be. As Ron has mentioned, select really is not a friend of efficient code. For example, your first four lines could be rewritten into one line as:
Sheets("Total").Range("D6923").End(xlDown).copy
However even this isn't the best way. I'm going to assume that you are working from the top of your sheet to the bottom and answer your question based on what I think you are trying to do. I'm also assuming that your sheet called Timeline is sheet 1 and your sheet called Total is sheet 2. Within total I am assuming that any number of entries could be there rather than just the two shown in the three examples given.
Sub ExampleCode()
'Variables, you can create and store things in VBA to make life easier for you
Dim Wb as Workbook 'This is the workbook you are using
Dim wsTimeline as Worksheet 'This is your worksheet called Timeline
Dim wsTotal as Worksheet 'This is your worksheet called as Total
Const rMin as byte = 5 'This is where the loop will start, I'm assuming row 5. As _
this won't change throughout the code and we know it at the _
start it can be a constant
Dim rMax as long 'This will be the last row in your loop
Dim r as long 'This will be how your loop knows which row to use
Dim timelineRow as long 'This will be the row that the data is pasted in Timeline
Dim timelineLastRow as Long 'This is the last row of data in your timeline sheet
Set Wb = Thisworkbook 'Your whole workbook is now stored in the variable Wb
Set wsTimeline = Wb.Sheets("Timeline") 'As the workbook was stored in Wb we can use it as _
shorthand here. Now the sheet Timeline is in wsTimeline
Set wsTotal = Wb.Sheets("Total") 'Same as above, this sheet is now stored
rMax = wsTotal.Cells(Rows.Count, 1).End(xlUp).Row 'This is the equivalent of starting at the _
bottom row in column A and pressing _
Ctrl+Up. This takes you to the last _
row of data in column A. …(Rows.Count, 2)… _
would be column B etc.
timelineLastRow = wsTimeline.Cells(Rows.Count, 1).End(xlUp).Row
'This is the bit where you start to loop, the line below basically says "Do the code in this _
loop for every value between rMin and rMax, each time make 'r' that value (r for row!)
With wsTotal 'Means that anything below starting with '.' will _
be the same as 'wsTotal.'
For r = rMin To rMax
'Ensure working on a line with data
If .Cells(r, 1) = "" Then
r = .Cells(r, 1).end(xlDown).row
If r > rMax Then
End With 'Closes the With statement above as no longer needed.
Exit For 'Exits the loop as we have ended up beyond rMax
End if
End if
'This will look for the person in wsTimeline and if they aren't there then add them
If IsError(Application.Match(.Cells(r, 1), wsTimeline.Range("A3:A" & timelineLastRow), 0)) Then
wsTimeline.Cells(timelineLastRow + 1, 1) = wsTotal.Cells(r, 1)
timelineRow = timeLineLastRow + 1
timelineLastRow = timelineRow
Else
timelineRow = Application.Match(.Cells(r, 1), wsTimeline.Range("A3:A" & timelineLastRow), 0)
End If
'I'm assuming that all records in 'Total' are chronologically ascending with no gaps between _
each row for a single person.
wsTimeline.Cells(timelineRow, 3) = .Cells(r + 2, 4)
If .cells(r + 3, 4) <> "" then
wsTimeline.Cells(timelineRow, 4) = .Cells(r + 2, 4).End(xlDown)
Else
wsTimeline.Cells(timelineRow, 4) = .Cells(r + 2, 4).End(xlDown)
End If
'Now that the data has been brought across from Total to Timeline we can move on to _
the next row.
Next r 'This will add one to the value stored in r and start the code again where _
the loop started
End With
'The loop has now ended having gone through every row in your worksheet called Total.
End Sub
I am a novice to VBA, and I would greatly appreciate your help. I need to automate a task that I am doing as a part of my research.
I have two Workbooks, one with multiple spreadsheets (one for each sound measurement, its name is Matlab Contours_Extracted_20170815.xlsx), and another one, where I need to consolidate the first column from each spreadsheet of the first one (it's called Mat-lab Contours consolidated.xlx).
I managed to get as far as automatic one-by-one copy and paste process, and it is working, but I would like it to go until it hits the end of a document (and it is not a set number of sheets).
Below is the code that I have, and here are my questions:
How do I loop it, so it goes through all the spreadsheets until the end by itself?
How do I make it start with the first one (I had it, but I lost it now, and it jumps straight to Sheet+1). Not a huge issue, but would be most helpful.
In the end how can I get it to leave cursor in the last empty cell of the first row, rather than the first one? In this case I put 1,1 intentionally, because I tried to put it in the end and failed. But I would like it in the end. :)
I would greatly appreciate anyone's help! Thanks a lot! :)
Here is the code:
Windows("Matlab Contours_Extracted_20170815.xlsx").Activate
Columns("A:A").Select
Selection.Copy
Windows("Matlab Contours consolidated.xlsx").Activate
Selection.ColumnWidth = 12.17
c = Cells(1, 1).End(xlToRight).Column + 1
Cells(1, c).Select
ActiveSheet.Paste
Windows("Matlab Contours_Extracted_20170815.xlsx").Activate
Sheets(ActiveSheet.Index + 1).Activate
Columns("A:A").Select
Application.CutCopyMode = False
Selection.Copy
Windows("Matlab Contours consolidated.xlsx").Activate
ActiveSheet.Paste
Selection.ColumnWidth = 14.17
Rows("1:1").Select
Application.CutCopyMode = False
With Selection
.WrapText = True
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
Range("A1").Select
End Sub
you could try this :
Sub Matlab_Copy_Paste()
Dim Wb1 As Workbook
Dim Wb2 As Workbook
Dim i As Integer
Dim a As Integer
Set Wb1 = Workbooks("Matlab Contours_Extracted_20170815.xlsx") 'Adapt to your origin workbook
Set Wb2 = Workbooks("Matlab Contours consolidated.xlsm") 'Adapt to your destination workbook
a = 1
For i = 1 To Wb1.Sheets.Count
Wb1.Sheets(i).Range("A1:A" & Wb1.Sheets(i).Range("A999999").End(xlUp).Row).Copy Wb2.Sheets(1).Cells(1, a)
a = a + 1
Next i
Wb2.Sheets(1).Range("XFD1").End(xlToLeft).Offset(0, 1).Select
'Edit for transpose result
T1 = Wb2.Sheets(1).UsedRange
Wb2.Sheets(1).Cells.Clear
Wb2.Sheets(1).Range("A1").Resize(UBound(T1, 2), UBound(T1, 1)) = Application.Transpose(T1)
'End of edit for transpose result
End Sub
Not sure if you really wanted it pasted side by side tho...
I have recorded this macro in excel. The idea is to go through all rows (100)
and repeat the SUB. I think i figured the proper algorithm (I have basic Turbo Pascal knowlege).
Here is my algorithm:
Create a loop that is using a variable, i, for counting.
For i from 2 (we start from row 2, row 1 has headers) to 200 (even if we initially have 100 rows by the time the scrip will finish executing we will have doubled the amount of rows)
Do the sub
How do I make Rows("2:2") for example to reference the current value of i.
How do Rows("3:3") to use the value i+1.
How do I make Range("B2") to use the value B(i)
I am stuck with the loop and the proper syntax Please help. Also since I want to get deeper into the topic could you please suggest some good sources? I was not really interested in coding after during high school, but now I want to get deeper into the topic.
Sub Macro2()
Rows("2:2").Select
Selection.Copy
Rows("3:3").Select
Selection.Insert Shift:=xlDown
Range("B2").Select
Application.CutCopyMode = False
Selection.Cut
Range("A3").Select
ActiveSheet.Paste
End Sub
Something like this:
Sub Macro2()
Dim i As Long
For i = 100 To 2 Step -1
Rows(i).Copy
Rows(i + 1).Insert shift:=xlDown
Cells(i, 2).Cut Cells(i + 1, 1)
Next i
End Sub
I removed the .Select and .Activate It slows down the code. See HERE for good guidance on such.
When adding or subtracting rows it is best to iterate from bottom to top. The Step - 1 does that. It starts at row 100 and goes up till row 2.
Another note you will want to designate the sheet so that it looks at the correct sheet:
Sub Macro2()
Dim ws as Worksheet
Dim i As Long
Set ws = Sheets("Sheet1") 'Change to your sheet.
For i = 100 To 2 Step -1
ws.Rows(i).Copy
ws.Rows(i + 1).Insert shift:=xlDown
ws.Cells(i, 2).Cut ws.Cells(i + 1, 1)
Next i
End Sub
I am new to writing VBA and not sure to to complete this loop. I am reading down a column and identifying the cell color. If the cell color is correct then i preform the action. The problem is that action pastes that info into cell N7. That is where my loop gets messed up because i need it to go the cell A9 next. Can some one explain what the next step would be. I know that need to put that cell A8 in a loop and increase by 1 each time but not sure how to do that.
Range("A8").Select
Do
If ActiveCell.Interior.Color = RGB(79, 129, 189) Then
ActiveCell.Offset(1, 0).Select
Selection.End(xlDown).Select
ActiveCell.Offset(-1, 0).Select
Range(Selection, Selection.End(xlUp).Offset(1, 0)).Select
Selection.Copy
Range("N7").Select
ActiveSheet.Paste
ElseIf ActiveCell.Select = "BREAK" Then
Exit Sub
Else
ActiveCell.Offset(1, 0).Select
End If
Loop
End Sub
Edit: updated script below to copy data per additional comments
.Select and .Activate are common sources of run-time errors and can likely be avoided in this case. Though I'm not really clear on the action you're trying to take when you identify the color in column A, you could use the following heavily-commented script to accomplish the "loop-and-check-for-BREAK" action.
Option Explicit
Sub ProcessColumnA()
Dim Counter As Long
Dim MySheet As Worksheet
Dim Cell As Range, DestCell As Range
'set references up-front
Counter = 8
Set MySheet = ThisWorkbook.ActiveSheet
Set Cell = MySheet.Cells(Counter, 1)
Set DestCell = MySheet.Cells(7, 14)
'loop on column A until we find "BREAK" or
'counter is greater than 10K, whichever comes first
Do Until Cell.Value = "BREAK" Or Counter > 10000
'check color and take action if necessary
If Cell.Interior.Color = RGB(79, 129, 189) Then
'do the copy work here
Cell.Copy Destination:=DestCell
'increment the destination cell
Set DestCell = DestCell.Offset(1, 0)
End If
'increment the counter variable and set the next cell
Counter = Counter + 1
Set Cell = MySheet.Cells(Counter, 1)
Loop
'send user a message regarding the results
If Counter > 10000 Then
MsgBox ("Whoa you hit 10K cells before finding 'BREAK'...")
Else
MsgBox ("Processing complete!")
End If
End Sub