My first row of my dataset includes a list of 1's or 0's. I am trying to just hide all rows that contain a zero, then copy the entire sheet to a new sheet. I timed it out and the macro takes around 4 minutes to complete running. Why? Is there a way to re-write this macro to make it quicker? I'm trying to keep this macro universal meaning as long as I have a column with 1's & 0's I can quickly hide large amounts of rows of data, not matter the size. Here is the code...Thank you in advance for any assistance!
Sub RemoveLinesWithZero()
For i = 1 To Selection.Rows.Count
For j = 1 To Selection.Rows.Count
If Left(Selection.Cells(j, 1), 1) = "0" Then
Rows(j + 13).EntireRow.Hidden = True
End If
Next j
Next i
ActiveSheet.Copy After:=Sheets(Sheets.Count)
End Sub
Related
I am new and I am working in a VBA - Excel Project.
My project has some Sub-projects, lets call them A,B,C...
Through VBA code and some actions I create new sheets that are called A-item-1, A-item-2 or B-item-1 or with C.
The thing is that I am creating these sheets by copying a template and printing it before the next letter.
For example, B-item-3 is created copying my B-item-template and printing it before C sheet.
Now, the way the program works you can create B-item-1, B-item-4, hit the button and it will create them.
If after that you want to create B-item-2, as the program puts it before C you will have this:
A,B,B-item-1,B-item-4,B-item-2,C (this is my workbook)
And I am thinking on a code to rearrange only "B-item-X" sheets.
As far as i know i should put these sheets in an Array.
Then i should, somehow, get the number from every sheet to a variable.
And then compare with a for these sheets and if the number is less than the sheet i am comparing it to, move that sheet.
I think it could look like this?
1st - Determine the Range of sheets I want to rearrange
2nd - Somehow extract the number of each "B-item-X" sheet
3rd-->
For i=1 to Range of sheets -1
For j= i + 1 to Range of sheets
if The number on the name of the (j) Sheet is < The number on the name of the (i) Sheet then
Sheets(j).Move before:= Sheets(i)
End if
Next j
Next i
I hope it is easy to understand what i want to do. If not, hit me up and i will try to explaint it with more details. I hope someone can help me. Thank you very much.
Edit:
The way the program works. The user writes an input and based on that I have a non visible chart in which i write 0 or 1 depending on the input of the user. Then the program creates the ITEM sheet if it sees a 1 on the chart.
As an example, for the 20 items i can create:
The user puts YES (1 in the Chart) on ITEMS 1,7 and 15 and presses the button OK.
The program creates them and you would have these sheets:
A,B,B-item-1,B-item-7,B-item-15,C,D...
But the program is still used for next Batches, lets say.
So the next day the user puts YES on the item 9. The program will create the "B-item-9" sheet before C sheet but it will be put after the "B-item-15" sheet because it was already crated the day before that.
The thing is i do not know how to move them to the right place when creating them nor do i know how to rearrange them...
Try this
Sub SortSheetsTabName()
Dim scrUpdating As Boolean: scrUpdating = Application.ScreenUpdating
Application.ScreenUpdating = False
Dim i As Long, j As Long
Const txtBefNum As String = "B-item-"
With ThisWorkbook
For i = 1 To .Sheets.Count - 1
If .Sheets(i).Name Like txtBefNum & "*" And _
IsNumeric(Mid(.Sheets(i).Name, Len(txtBefNum) + 1)) Then
For j = i + 1 To .Sheets.Count
If .Sheets(j).Name Like txtBefNum & "*" And _
IsNumeric(Mid(.Sheets(j).Name, Len(txtBefNum) + 1)) Then
If CLng(Mid(.Sheets(i).Name, Len(txtBefNum) + 1)) > _
CLng(Mid(.Sheets(j).Name, Len(txtBefNum) + 1)) Then
.Sheets(j).Move before:=.Sheets(i)
End If
End If
Next j
End If
Next i
End With
Application.ScreenUpdating = scrUpdating
End Sub
This will sort all worksheets that have a name starting with 'B-item-' according to the number in their name following that text from smallest to largest.
As shown in image, I am trying to fill numbers in increasing order in alternate merged cells, which are different in size. So, I can't use autofill function of excel. But I want a macro so I can do it every time just hitting button once.
Note that I want numbers till the used range only.
I tried a lot to do it my self, but I am stuck now...Plz help the beginner, it's my third day in VBA.
This should do what you are looking for.
It will ignore non merged cells, I didn't see any in your screenshot that needed a number and were not merged so that shouldn't be an issue.
It uses column B to figure out the last row of your data.
Dim i As Long
Dim lr As Long
Dim counter As Long
counter = 1
With Sheet1 'Change to whatever your sheets code name is
lr = .Cells(.Rows.Count, 2).End(xlUp).Row 'If you want to use something other than column B, change the 2 to the right column index
For i = 2 To lr
If .Cells(i, 1).MergeCells = True Then
If .Cells(i, 1).MergeArea.Item(1).Address = .Cells(i, 1).Address Then
.Cells(i, 1) = counter
counter = counter + 1
End If
End If
Next i
End With
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 would like to create a excel Macro that allows to me copy an x number of rows of certain column. For Example, I have column K that I have in 10.500 rows. I want to copy 1000 lines each time and also the 500 lines at the end. any help with the coding part ? I looked on so many sites and no success. I don't need to paste the copied number in any other excel sheet. I just need the macro command to copy me 1000 lines every time from the column that I selected.
thank youuuuu very much and much appreciated !
Cheers
Select a column and run the sub procedure from the Macros dialog (Alt+F8). The first 1000 cells will be copied to the clipboard.
Paste the data into another program.
Return to Excel and run the sub procedure again. The next 1000 rows of data will be copied to the clipboard.
When the last group of data has been copied to the clipboard, a message box will notify.
Option Explicit
Sub progressiveCopy()
Dim m As Long
Static i As Long, k As Long
Application.CutCopyMode = False
m = 1000
If k <> ActiveCell.Column Then
k = ActiveCell.Column
i = 0
End If
With Worksheets("sheet1")
m = Application.Min(m, .Cells(.Rows.Count, k).End(xlUp).Row - i)
.Cells(i + 1, k).Resize(m, 1).Copy
i = i + m
If i >= .Cells(.Rows.Count, k).End(xlUp).Row Then
MsgBox "This column is complete. Select another column next time."
End If
End With
End Sub
You may wish to set up a hot-key combination for the sub procedure in the Macros dialog to ease repetitive operations.
This code finds the number of rows in the currently selected column. Checks if the number to be copied is less than the rows left. Selects the range and puts the range in copy mode. After the range is copied you would have to go to they sheet, document, or whatever to paste the data.
I've modified the code to then select down 1000 rows or what ever is left in the column. So you should be able to run the code, paste the data, run the code, paste the data. When you hit the end, a message tells you that you are at the end of the column.
Application.CutCopyMode = False
numRowstoCopy = 1000
varCurrentRow = ActiveCell.Row
varCurrentColumn = ActiveCell.Column
FinalRow = Cells(Rows.Count, varCurrentColumn).End(xlUp).Row
varRowsToEnd = FinalRow - varCurrentRow
If varRowsToEnd < numRowstoCopy Then
Range(Cells(varCurrentRow, varCurrentColumn), Cells(varCurrentRow + varRowsToEnd, varCurrentColumn)).Select
Selection.Copy
MsgBox "Last Rows to Paste Have been copied"
Else
Range(Cells(varCurrentRow, varCurrentColumn), Cells(varCurrentRow + numRowstoCopy - 1, varCurrentColumn)).Select
Selection.Copy
ActiveCell.Offset(numRowstoCopy, 0).Select
End If
I have a series of macros that will insert data pertaining to which button is selected. The problem that I am having is that I have a series of 5 buttons each running a macro containing a different number of rows of data. After the data is entered from the macro, I have the same 5 buttons for the user to select another group of data. Since each macro is a different number of rows it keeps screwing up the formating (example: the 2nd set of macros is set to run in row 3, but when the first set is selected the data continues until row 5). Any advise on how to fix this?
Here is my macro's code:
Sub Realestate()
Sheet14.Unprotect Password:="Loan101"
Range("AV1:CP20").Select
Selection.Copy
ActiveWindow.ScrollColumn = 4
ActiveWindow.ScrollColumn = 3
ActiveWindow.ScrollColumn = 2
ActiveWindow.ScrollColumn = 1
Range("A11:AU11").Select
Selection.Insert Shift:=xlDown
Range("U13:AA13").Select
Application.CutCopyMode = False
ActiveCell.FormulaR1C1 = "=Application!R[10]C[3]"
Range("I14:Q14").Select
ActiveCell.FormulaR1C1 = "=Application!R[119]C[9]"
Range("K24:O24").Select
ActiveCell.FormulaR1C1 = "='Consumer Loan Request'!R[-4]C[-1]"
Range("P24").Select
Rows("20:20").RowHeight = 3
Rows("30:30").RowHeight = 3
Range("j12:w12").Select
Sheet14.Protect Password:="Loan101"
End Sub
The code needs several fixes to be optimized, but the way SO works is to answer one question each time so that future users will find it useful as well. I will hence, in this thread, limit to answer your question: "How can I make a macro starting from the row where the previous one ended?"
The trick is to store the value of the row in a global variable, i.e. a variable whose scope is not limited to the single macro but to the whole module. In order to reach this (please adapt this small example to your code, since nobody can see the project so this can only be a hint):
1) Declare the global variable on top of all macros:
Dim rowStart As Long
2) Write your macros:
Dim rowStart As Long
Sub Macro1()
'code
End Sub
Sub Macro2()
'code
End Sub
So, here's the hint. Make your first macro perform some operations, for example putting 20 random numbers into the first 20 cells of the column "B":
Sub Macro1()
For j = rowStart To rowStart + 20 'rowStart has not been modified yet, so it's equal to 0 by default
Sheets("YourSheet").Range("B" & j+1).Value = Rnd() '"B" & j will be "B1" the first time, "B2" the second time etc.
Next j
rowStart = j 'here we store the value "20", i.e. the last value of j, into the global variable so that we can reuse it after
End Sub
Once this is done, let's say that your second macro will want to add other 10 random numbers to the existing list already created from the first macro. To do this:
Sub Macro2()
For j = rowStart To rowStart + 10 'now rowStart = 20, so we will start from the last row where the previous macro ended!
Sheets("YourSheet").Range("B" & j+1).Value = Rnd()
Next j
rowStart = j 'now we store the value "30", so next time you want to know the last row used, you will know it
End Sub
Unfortunately, your code is very complicated to read and understand what it's doing (I imagine it's recorded since I still see the ActiveWindow.ScrollColumn command coming from you moving up and down your spreadsheet manually).
So, my suggestion is to start from these two tips:
Global variables will help you to keep in memory the last rows touched from your macros;
String merging (Range("B" & j)) will help you to reference objects dinamically.
In general, use the Macro recorder to learn about the commands, but write your own code: it might take a bit longer in the beginning, but you will make sure that the code is flexible and able to adapt to any kind of similar problem. Here's a good tutorial to get started with.