I need to consolidate 2 students’ registrations between different workbooks (holding and subsidiary). So when I click the button “Generate Graphic”, the data are consolidated in the sheet “Total” and then, the number of courses (Excel, Word, Access…) are counted and the graphic is generated in the sheet “Graphic”. The first test is ok, but when I click again, the list is increasing with the same data of the subsidiary’s workbook. There’s something in the code I need to change but I don’t know what.
Could you help me?
My code is:
Sub GerarGrafico()
Dim k As Long
'copying data of the “Course Booking” Sheet
Sheets("Course Booking").Select
Range("A1").Select
linini = 2
'Select the last row
Selection.End(xlDown).Select
linfin = Selection.Row
'Select the last column
Selection.End(xlToRight).Select
colfin = Selection.Column
Range(Cells(linini, 1), Cells(linfin, colfin)).Select
Selection.Copy
‘copying data in the sheet "Total"
Sheets("Total").Select
Cells(linini, 1).Select
ActiveSheet.Paste
Application.CutCopyMode = False
‘Copying data of the “reserva filial.xlsm”
caminho = ThisWorkbook.Path
Workbooks.Open caminho & "\" & "reserva filial.xlsm"
'copying data
Range("A1").Select
linini2 = 2
'Select the last row
Selection.End(xlDown).Select
linfin2 = Selection.Row
'Select the last column
Selection.End(xlToRight).Select
colfin2 = Selection.Column
Range(Cells(linini2, 1), Cells(linfin2, colfin2)).Select
Selection.Copy
Windows("Trabalho_Felipe Granado_v8.xlsm").Activate
Sheets("Total").Select
'Select the last row with value
Selection.End(xlDown).Select
k = ActiveCell.Row + 1
Cells(k, 1).Activate
Application.Windows("reserva filial.xlsm").Visible = False
'pasting data "reserva filial.xlsm" in the sheet "Total"
ActiveSheet.Paste
Application.CutCopyMode = False
Columns.HorizontalAlignment = xlCenter
This part of the code navigates to the end of the data in the sheet
'Select the last row with value
Selection.End(xlDown).Select
k = ActiveCell.Row + 1
Cells(k, 1).Activate
Then you paste in "reserva filial.xlsm" data.
It works fine on the first pass, but the second time you run the code, you (correctly) paste in the first workbook data, LEAVING THE SECOND WORKBOOK DATA BENEATH IT, navigate to the end of the data, and repaste in the second workbook data.
Depending on how your Excel project fits together you might wish to clear the entire contents of Sheets("Total") or a subset of it using the .ClearContents method.
It works as the Ctrl + Shift + Down (arrow) and Ctrl + Shift + Right (arrow) in Excel. For now it's ok and it will be used only as a list. I really appreciatte your advise. I am a new VBA and Stack Overflow user, and this community is very useful because all of your contribution.
Related
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
Title isn't the best so here a an overview.
I'm using VBA to copy select columns from one workbook to another, as what will be part of a larger automated program.
On the Workbook I am copying from, there are different sheets containing a "Stock Number" column. When pasting into my other workbook, I am trying to get these columns to merge into 1 single column (pasting below the last entry from the first sheet and so on).
Here is my current code:
Sub import_adam_article()
Windows( _
"copyfrom.xlsx" _
).Activate
Columns("F:G").Select
Selection.Copy
Windows("pasteinto.xlsx").Activate
Columns("A:A").Select
ActiveSheet.Paste
Windows( _
"copyfrom.xlsx" _
).Activate
Columns("N:N").Select
Application.CutCopyMode = False
Selection.Copy
Windows("pasteinto.xlsx").Activate
Columns("C:C").Select
ActiveSheet.Paste
Rows("1:1").Select
Selection.Delete Shift:=xlUp
NextRow = Range("A1").End(xlDown).Row + 1
Windows( _
"copyfrom.xlsx" _
).Activate
Columns("F:G").Select
Selection.Copy
Windows("pasteinto.xlsx").Activate
Range("A" & (NextRow)).Select
ActiveSheet.Paste
[A:C].Select
With Selection
.NumberFormat = "General"
.Value = .Value
End With
End Sub
The difficulty is that the amount of Stock Numbers will change every new file that comes through, so it needs to be able to adjust to varying amounts.
I can't seem to find a way to make it work and I've tried searching for answers elsewhere.
EDIT: The current issue with the code that it is selecting the next empty row to paste into, but only that cell, not a variable length down as required by the copyfrom column.
Want to do:
A.If only one row is present in the data sheet, copy and paste that lone row and paste it to the named sheet
B.if there are multiple rows of data, copy all then paste
Issues Having with Current Code:
it disregards the first if condition and goes straight to the next one which copies the range and everything below even if theres only one row of data present.
here's my code with the following condtions:
ws2 = source data sheet
wsA = sheet data will be pasted on
copied data if conditions are met should be pasted on the last available blank row in column A of WsA
k = ws2.Range("a6", ws2.Range("a6").End(xlDown)).Rows.Count
If k <= 1 Then
ws2.Activate
rngB.Select
Selection.Copy
wb2.Activate
wsA.Activate
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
Else
ws2.Activate
rngB.Select
Range(rngB, ActiveCell.End(xlDown)).Select
Selection.Copy
wb2.Activate
wsA.Activate
Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Select
ActiveSheet.Paste
Application.CutCopyMode = False
End If
data sheet
If there is no data below row 6 then ws2.Range("a6").End(xlDown) will extend down to the bottom of the sheet (so k > ~1000000)
To detect if only one row of data exists, try
If IsEmpty(ws2.Range("a6").Offset(1,0) then
' Only one row
Else
' More than one row
End If
And, head the advise to avoid select.
Hi and thanks for your help.
I've two Excel files, lets call them Excel 1 (active one), and Excel 2 (which I just need to compare if there's duplicates).
I want to remove the matches from Excel 1 that are found in Excel 2. Only deleting the matches from Excel 1, and keeping the Excel 2 intact.
I normally do this process with a Vlookup then delete the matches.
[Example][1]: =VLOOKUP(C2,'[End Use Screening Log.xlsb]EUS Log'!$A:$A,1,0))
This is the macro code produced after the Vlookup:
Sub Testing()
'
' Testing Macro
'
'
Workbooks.Open Filename:= _
"Z:\Customer Screening\End User Screening Log\End Use Screening Log.xlsb"
Windows("Copy of WW33 TEST .xlsm").Activate
Range("G2").Select
ActiveCell.FormulaR1C1 = _
"=VLOOKUP(RC[-4],'[End Use Screening Log.xlsb]EUS Log'!C1,1,0)"
Range("G2").Select
Selection.AutoFill Destination:=Range("G2:G16")
Range("G2:G16").Select
Range("G1").Select
Selection.AutoFilter
ActiveSheet.Range("$A$1:$Q$16").AutoFilter Field:=7, Criteria1:=Array( _
"4997466", "6392634", "9026175", "9362935", "9363654", "9369599", "9370171"), _
Operator:=xlFilterValues
Range("A2").Select
Range(Selection, Selection.End(xlDown)).Select
Range(Selection, Selection.End(xlToRight)).Select
Rows("2:2").Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Delete Shift:=xlUp
Range("E15").Select
Selection.AutoFilter
Range("G2:G9").Select
Selection.ClearContents
Range("Q2").Select
End Sub
However, I'm trying to automatize the process to do it just with one click.
I want to compare column C from Excel 1 against column A from Excel 2.
I guess I'd need to do it with a VBA, because I've tried it recording the macro but doesn't work properly.
Any ideas how to make this possible?
Maria
I created a very crude code that might just work for your needs. I do not know what your worksheets look like and what your exact needs are but I just assumed you're just matching each cell of column C of Excel 1 to the values at column A of Excel 2, and if there is a match, the cell at row C of Excel 1 will be deleted.
Excel1 Workbook:
Excel2 Workbook:
Code:
Sub Macro1()
Start = 2
'Change path to your excel's file name
'This will open your 2nd excel file so that you won't have to open it evertime. Delete when not needed
Workbooks.Open ("C:\Users\Pops\Desktop\Excel2.xlsm")
'The deletion of the row will mess up with the For-Next loops so I included a GoTo so this is where it will end up
ReLoop:
'Counts how many rows are in your worksheets
Total_rows_Excel1 = Workbooks("Excel1.xlsm").Worksheets("Sheet1").Range("C" & Rows.Count).End(xlUp).Row
Total_rows_Excel2 = Workbooks("Excel2.xlsm").Worksheets("Sheet1").Range("A" & Rows.Count).End(xlUp).Row
'Loops on all the rows on your worksheet
For i = Start To Total_rows_Excel1
For j = 2 To Total_rows_Excel2
If Workbooks("Excel1.xlsm").Worksheets("Sheet1").Range("C" & i) = Workbooks("Excel2").Worksheets("Sheet1").Range("A" & j) Then
Workbooks("Excel1").Worksheets("Sheet1").Rows(i).Delete Shift:=xlUp 'Deletes the rows in Excel1 that have a match from Excel2
Start = i 'This will let the loop to start at the last row it stopped when it loops again so it's less computationally taxing
GoTo ReLoop
End If
Next j
Next i
End Sub
So at the click of a button, all the matches in Excel 1's column C to Excel 2's column A will be removed.
Result:
I have a workbook with approx 20 sheets, which are identical in format and setup. Only the sheet names differ (like "1010", "1020", "1030" and so on).
Now I would like to copy from every sheet Column D to a newly created sheet, however:
Column D from sheet "1010" needs to go to Column G in the newly created sheet.
Column D from sheet "1020" needs to go to Column H in the newly created sheet.
and so on.
I have manually created the following code for copy/paste Column D into the new sheet.
Sheets("1010").Select
Columns("D:D").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("1000 (2)").Select
Range("G1").Select
ActiveSheet.Paste
Sheets("1020").Select
Columns("D:D").Select
Application.CutCopyMode = False
Selection.Copy
Sheets("1000 (2)").Select
Range("H1").Select
ActiveSheet.Paste
Somehow I think this can go faster, although i have no idea how. Please advice.
This should do want you need:
Sub marine()
Sheets.Add after:=Sheets(Sheets.Count)
ActiveSheet.Name = "compilation"
For i = 1 To Sheets.Count - 1
Sheets(i).Range("D:D").Copy Cells(1, 6 + i)
Next i
End Sub