I have a text based system with people's names, and I need to copy and paste the first 4 cells (not a problem) and the last 5 cells to a different worksheet for analysis.
The problem arises with the transfer from the text based system the data is presented in, to the spreadsheet when it comes to people with spaces in their surname (ie, Da Silva). I use text to columns, which will give me a variant number columns, depending on the number of spaces in the name which is an issue.
I already have a crude solution, but the time it takes and the jumping about between screens while the macro is running looks very unprofessional. I don't get much spare time at work, and I don't have the tools to test this properly at home.
Can anyone help me get this to loop until the last empty cell, and basically neaten it up a little?
The code, which repeats 300 times, is as following:
Sheets("Late list Sorting").Select
Range("A2").End(xlToRight).Select
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, -5)).Select
Selection.Copy
Sheets("Late list").Select
Range("D4").Select
ActiveSheet.Paste
(...Repeat until...)
Range("A300").End(xlToRight).Select
Range(ActiveCell.Offset(0, 0), ActiveCell.Offset(0, -5)).Select
Selection.Copy
Sheets("Late list").Select
Range("D302").Select
ActiveSheet.Paste
Sheets("Late list Sorting").Select
If you only want the values (not formulae or formatting) then you can simply use Value=Value...
Dim i As Long, sWs As Excel.Worksheet, tWs As Excel.Worksheet
Set sWs = ThisWorkbook.Worksheets("Late list Sorting")
Set tWs = ThisWorkbook.Worksheets("Late list")
For i = 2 To 300
tWs.Range(tWs.Cells(i + 2, 4), tWs.Cells(i + 2, 8)).Value = sWs.Range(sWs.Cells(i, 1).End(xlToRight), sWs.Cells(i, 1).End(xlToRight).Offset(0, -5)).Value
Next
it is inefficient to use .Select, here's a great resource: How to avoid using Select in Excel VBA
To eliminate the screen flashes, put this at the beginning of your code. Remember to turn it back to true at the end.
Application.ScreenUpdating = False
You want to use a loop, where the variable i becomes the row number you will reference like so:
Range("A" & i).Value...
There are many ways to loop, here is one example:
For i = 1 to 300
//All your code here
Next i
Related
For example, on some sites,
I already study & try on Macro for insert HPageBreak Present on Every occurrence on particular text, with loop every cell of single column, but my requirement is every 2nd occurrence of particular txt
https://answers.microsoft.com/en-us/msoffice/forum/all/excel-macro-that-will-insert-horizontal-macros/9976e30a-8aae-4bec-84e8-43b35b113ec2
https://answers.microsoft.com/en-us/msoffice/forum/all/insert-dynamic-page-breaks-with-vba-for-excel/85790a6a-ef93-4354-8ad5-3cc5e4399285
https://www.extendoffice.com/documents/excel/1774-excel-insert-page-break-every-row.html
I already use Below code to put Hpagebreak on every found
but now requirement raise as every 2nd occurrence of "DISPATCH JAN TO NOV-22"
Sub Insert_Pagebreak_On_EveryFoundok()
Dim MYCOLUMN As Range
Dim MyCell As Range
'For Each MyCell In Range("G2:G" & Rows.Count).End.xlUp))
'For Each MyCell In Range Cells(Rows.Count, 2).End(xlUp).row 2
ActiveSheet.Range("G" & Rows.Count).End(xlUp).row))
ActiveWindow.view = xlPageBreakPreview
Set MYCOLUMN = ActiveSheet.Range("F2:F" & ActiveSheet.Range("F" & Rows.Count).End(xlUp).row)
For Each MyCell In MYCOLUMN
MyCell.Select
'If MyCell.Value Like "*Page 1 of 1*" Then
If MyCell.Value Like "*DISPATCH JAN TO NOV-22*" Then
ActiveCell.EntireRow.Select
ActiveWindow.SelectedSheets.HPageBreaks.Add
ActiveCell.offset(1, 0)
Else
ActiveCell.offset(1, 0).Select
End If
Next
ActiveWindow.view = xlNormalView
End Sub
This Loop check every cell that take more time, but I believe if use Range.Find method, then it can be more robust.
I am not knowing very well all aspects of VBA, but I daily use VBA in my many types of daily routine work & without it, I can't complete my work on time.
Currently I manually select 2 sets of data, adjust rows height to fit on A4, select -set-click print area & then print, and after print that I select below further 2 sets & do same thing, till sheet's data end,
painfully pass whole my day, just for print 2 data set on 1 A4 page.
There are need to beware for Hidden rows which hides for reason (not requirement in print). so, condition is only visible rows should be count for 2nd occurrence.
I attached Screen shot of whole scenario for reference.
[Plese Refer This Image as my situation]
enter image description here
Hundreds of data sets on this worksheet.
There should be 2 sets of data as pair require on every A4 size page.
so obviously page break requires on every 2nd occurrence of particular text.
If, that happen successfully, I am ready to manually adjust rows height to fit 2 sets in A4 page, so I get whole sheet ready for print in one go.
Hope, I try my best to describe my situation if require further, please mention.
Can anyone help regarding this?
I really appreciate & will be thankful forever.
Regards,
Chirag Raval
I am a newbie to VBA but got tasked to work with it anyway. So my task is to build a macro that takes data from different sheets and puts it below each other in one result sheet ("Tabelle1" in my example). The input data in each sheet is stored in blocks of two columns, right next to each other - so columns A and B have to import into the result sheet, then C and D and so on. Doing this for one sheet is not a problem:
Sub Makro1()
'
' Makro1 Makro
'
Dim Erste As Long
Dim k As Long
Dim j As Long
k = 1
j = 2
Do
Sheets("Tabelle1").Select
Erste = ActiveSheet.Cells(Rows.Count, 3).End(xlUp).Offset(1, 0).Row
Sheets("Tabelle2").Select
Range(Cells(5, k), Cells(5, j)).Select
Range(Selection, Selection.End(xlDown)).Select
Selection.Copy
Sheets("Tabelle1").Select
Cells(Erste, 3).Select
ActiveSheet.Paste
k = k + 2
j = j + 2
Loop Until Sheets("Tabelle2").Cells(4, k).Value = ""
End Sub
But I not only have one input sheet ("Tabelle2" in this example) but several (up until sheet20 or so). And all of them are built the exact same way, only with different data in each. What I would need the macro to do is, when reaching the empty cell in the first input sheet ("Tabelle2), go to the next input sheet ("Tabelle3") and continue the import of the data.
It doesn't sound too hard to do at first, but I cannot seem to find a solution. If anyone could help me out, it would be very much appreciated :-)
I know that the macro itself is very badly written and I can get rid of most of the Select. But as long as it works I'm fine.
Instead of using the name of the sheet, use the Index
Example: Sheet(1) and Sheet(2) etc
You can use that number as a variable that you can increment.
Example:
Dim i as Integer
Sheet(i).Select
Note:
It is also better practice to change the code to not rely on .Select as it can cause confusion and problems.
In addition, it would be better to use Worksheet(1) as charts can also be referred to as sheets.
I am working with multiple sheets within a workbook. Each sheet has an identical header row. I would like to write a macro to copy a range of data from each sheet (A2:L2 to the last row of data on a sheet) and paste it into the first empty cell in Column A of master sheet.
What I have below doesn't seem to work. Any assistance is appreciated.
Dim Lastrow As Integer
Lastrow = ActiveSheet.Cells(Rows.Count,1).End(xlUp).Row
Sheets("Master Sheet").Range("A2:L10000).Clear
Sheets("Sheet1").Activate
Range("A2:L" & Lastrow).Select
Selection.Copy
Sheets("Master Sheet").Select
Range("A30000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1,0).Range("A1").Select
ActiveSheet.Paste
Sheets("Sheet2").Activate
Range("A2:L" & Lastrow).Select
Selection.Copy
Sheets("Master Sheet").Select
Range("A30000").Select
Selection.End(xlUp).Select
ActiveCell.Offset(1, 0).Range("A1").Select
ActiveSheet.Paste
You're almost there from the looks of it. It looks like you've recorded a macro which is a good place to start. The reason your specific code might not work is because of Sheets("Master Sheet").Range("A2:L10000).Clear. You're missing the end quote inside of the range. In any case though, I've chosen to leave that out so you don't accidentally clear your sheet when you're moving data across
So generally it's good to avoid using select and activate, but with a recorder you don't have much say in the matter. Below you can see how I can do operations directly with the range.
It's important to find the last row of the master sheet as well as your current sheet each time so you know the range you want to copy and where you can paste it. It's important to remember that you're always finding the last filled cell, so in the case of a paste destination, you need to add one more to the row value so you don't accidentally overwrite some data.
For loops are pretty useful, I'm not sure what names you have for the rest of your sheets, but luckily in VBA you can use For each. so what this does is it cycles through every single item that you specify. In this case I've specified worksheets. The only problem now though, is we don't want to try copying and pasting into the same Master Sheet, so we need to do a quick check to make sure we're not on the master sheet. I've done this simply by comparing the name of the worksheet to what you've put as the name of the master sheet.
Interestingly when you copy something, you only need to specify the top left cell and it'll fill in the rest of it. It makes life a little easier because you don't need to figure out the exact dimensions of the array you're pasting. The Copy function in VBA has an optional parameter called Destination which you can use to tell it where you want to paste it right away.
It's also good to fully specify ranges when you're using them so instead of Range, you can see how I use ThisWorkbook.Worksheets("Master Sheet").Range. This tells the computer exactly where you want to reference; whereas Range makes the computer sort of guess, so it assumes you mean the active sheet, which might not be what you want.
Sub Paster()
Dim LastRowCurr As Long
Dim LastRowMaster As Long
Dim wksht As Worksheet
For Each wksht In ThisWorkbook.Worksheets
If Not wksht.Name = "Master Sheet" Then
LastRowCurr = wksht.Cells(wksht.Rows.Count, 1).End(xlUp).Row
LastRowMaster = Worksheets("Master Sheet").Cells(Worksheets("Master Sheet").Rows.Count, 1).End(xlUp).Row + 1
Range("A2:L" & LastRowCurr).Copy Destination:=ThisWorkbook.Worksheets("Master Sheet").Cells(LastRowMaster, "A")
End If
Next wksht
End Sub
I am new to Excel VBA and do not have much experience. I have two worksheets of data that I compare and then if a value matches up I copy and paste it to the second worksheet. I use for loops to compare every row and was wondering if there is a better way to do this? I am using brute force currently and was hoping there would be a way so that my program will not run for very long. (I repeat this block of code on different sheets 13 times). Essentially this code is consolidating information if it meets certain conditions. Below is my code.
Sub consolidate(z)
Sheets(z).Range("B1:AXH100").Delete '''deletes former values'''
For i = 1 To 30
For x = 1 To 500
If IsEmpty(Sheets("Sheet1").Cells(x, 13)) Then 'if cell value is empty skip it'
a = 1
Else:
If Sheets("Sheet1").Cells(x, 18) = Sheets(z).Cells(1, 1) Then 'check to see if value is same'
If Sheets("Sheet1").Cells(x, 13) = Sheets(z).Cells(i, 1) Then 'check to see if value is same'
Sheets("Sheet1").Cells(x, 15).Copy 'copy value'
Sheets(z).Select 'select second sheet'
Cells(i, 1).Select
ActiveSheet.Cells(ActiveCell.Row, Columns.Count).End(xlToLeft).Offset(0, 1).Select 'offsets cell to the
left'
Selection.PasteSpecial past:=xlPasteValues 'pastes'
End Sub
As I answered here, if you need to access or change several cells, you're much better off reading the cells into an array, working directly with the array(s) and sending the results back to Excel once you're done. It's quite a bit more work, and Excel's array-handling is not the best, but speed-wise there's no comparison.
This article explains the process in more detail.
I am trying to come up with a way to delete all rows (and shift cells up, if possible) where the website column cell contains the word none. The table contains 5000+ records and this would save me a great amount of time.
I appreciate any suggestions.
This is not necessarily a VBA task - This specific task is easiest sollowed with Auto filter.
1.Insert Auto filter (In Excel 2010 click on home-> (Editing) Sort & Filter -> Filter)
2. Filter on the 'Websites' column
3. Mark the 'none' and delete them
4. Clear filter
Ok I know this for VBA but if you need to do this for a once off bulk delete you can use the following Excel functionality: http://blog.contextures.com/archives/2010/06/21/fast-way-to-find-and-delete-excel-rows/ Hope this helps anyone
Example looking for the string "paper":
In the Find and Replace dialog box, type "paper" in the Find What box.
Click Find All, to see a list of cells with "paper"
Select an item in the list, and press Ctrl+A, to select the entire list, and to select all the "paper" cells on the worksheet.
On the Ribbon's Home tab, click Delete, and then click Delete Sheet Rows.
In the "Developer Tab" go to "Visual Basic" and create a Module. Copy paste the following. Remember changing the code, depending on what you want. Then run the module.
Sub sbDelete_Rows_IF_Cell_Contains_String_Text_Value()
Dim lRow As Long
Dim iCntr As Long
lRow = 390
For iCntr = lRow To 1 Step -1
If Cells(iCntr, 5).Value = "none" Then
Rows(iCntr).Delete
End If
Next
End Sub
lRow : Put the number of the rows that the current file has.
The number "5" in the "If" is for the fifth (E) column
I'd like to add to #MBK's answer. Although I found #MBK's answer to be very helpful in solving a similar problem, it'd be better if #MBK included a screenshot of how to filter a particular column.
This was alluded to in another comment, but you could try something like this.
Sub FilterAndDelete()
Application.DisplayAlerts = False
With Sheet1 'Change this to your sheet name
.AutoFilterMode = False
.Range("A3:K3").AutoFilter
.Range("A3:K3").AutoFilter Field:=5, Criteria1:="none"
.UsedRange.Offset(1, 0).Resize(ActiveSheet.UsedRange.Rows.Count - 1).Rows.Delete
End With
Application.DisplayAlerts = True
End Sub
I haven't tested this and it is from memory, so it may require some tweaking but it should get the job done without looping through thousands of rows. You'll need to remove the 11-Jul so that UsedRange is correct or change the offset to 2 rows instead of 1 in the .Offset(1,0).
Generally, before I do .Delete I will run the macro with .Select instead of the Delete that way I can be sure the correct range will be deleted, that may be worth doing to check to ensure the appropriate range is being deleted.
Try this ...
Dim r as Range
Dim x as Integer
For x = 5000 to 4 step -1 '---> or change as you want //Thanx 4 KazJaw
set r = range("E" & format(x))
if ucase(r.Value) = "NONE" then
Rows(x).EntireRow.Delete
end if
Next
Delete rows 1 and 2 so that your headings are on row 1
Put this in a macro (IT WILL CHECK THROUGH ROW 75000, YOU CAN LOWER THE NUMBER IF YOU WOULD LIKE
Columns("E:E").Select
Selection.AutoFilter
ActiveSheet.Range("$E$1:$E$75000").AutoFilter Field:=1, Criteria1:="none"
Range("E2:E75000").SpecialCells(xlCellTypeVisible).Select
Selection.EntireRow.Delete
ActiveSheet.Cells.EntireRow.Hidden = False
ActiveSheet.Range("$E$1:$E$75000").AutoFilter Field:=1
Columns("E:E").Select
Selection.AutoFilter
Range("E2").Select
Range("A1").Select