I need a small loop that cuts a row and inserts it at the row 2 for every worksheet.
The entire row should be detected or selected by only selecting a single cell in the first column.
I've tried adding a simple for each to the code (see below) but it end up sorting the every row by date.
Private Sub CommandButton2_Click()
For Each Worksheet In ThisWorkbook
Rows(ActiveCell.Row).Cut
Rows(2).Insert Shift:=xlDown
Next
End Sub
It should move the entire row, in every worksheet, to the top of the list by only selecting a cell and pressing the commandbutton in the first worksheet.
The entire row should be detected or selected by only selecting a single cell in the first column.
If someone could also explain how to work with Activevell and a loop through every worksheet that would be nice as well.
Well the bare minimum of code you are trying to use would look like:
Private Sub CommandButton2_Click()
For Each ws In ThisWorkbook.Sheets
ws.Rows(ActiveCell.Row).Cut
ws.Rows(2).Insert Shift:=xlDown
Next ws
End Sub
This would loop through all elements (sheets) in the sheets collection of the current workbook. Activecell is a reference to the focussed cell currently displayed on the active sheet, the sheet as where you press the commandbutton (assumed) as per your statement:
"It should move the entire row, in every worksheet, to the top of the list by only selecting a cell and pressing the commandbutton in the first worksheet."
I am not a big fan of For Each loop, that's why I'm using just for next loop :)
I think it should be useful :)
Private Sub CommandButton2_Click()
Dim numb As Integer
Dim i As Integer
Dim pos As Integer
numb = Application.Worksheets.Count
For i = 1 To numb
With Sheets(i)
.Select
pos = ActiveCell.Row
.Rows(pos).Cut
.Rows(2).Insert shift:=xlDown
End With
Next i
End Sub
If You still need answer for your last sentence add a comment, hope it helps :)
Related
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 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
I needed a dynamic frozen header row in Excel as the sheet I was working with had Several Tables that were large and were easier to understand if they were located on the same sheet.
But after searching endlessly I could not find a solution as there is no event for scrolling and scrolling doesn't change the active cell.
Thankfully I figured out a work around.
I was able to come up with an acceptable solution for my dilemma after searching for how to Identify the first visible row in the active window running across
MSDN: Identify First Visible Row of Active Window
I was then able to take that code and convert it to a function that could be used in combination with a Timer event that is only activated on the sheet I need the frozen row.
Sheet Code:
Private Sub Worksheet_Activate()
StartFreezePaneTimeRefresh
End Sub
Private Sub Worksheet_Deactivate()
StopFreezePaneTimeRefresh
End Sub
Dynamic Freeze Pane Module Code:
Private RefreshTime
Sub SetFreezePane()
'Check if correct worksheet is active
If ActiveWorkbook.ActiveSheet.Name = "Data" Then
If IdentifyTopVisibleRow < 227 Then
'Check if Frozen Row is the same as the Range to be Copied
If Range("A1") <> Range("AN1") Then
'Copy New Headers for Frozen Row
Range("AN1:BU1").Copy
Range("A1").PasteSpecial xlPasteValues
End If
ElseIf IdentifyTopVisibleRow > 227 Then
'Check if Frozen Row is the same as the Range to be Copied
If Range("A1") <> Range("AN2") Then
'Copy New Headers for Frozen Row
Range("AN2:BU2").Copy
Range("A1").PasteSpecial xlPasteValues
End If
End If
Else
StopFreezePaneTimeRefresh
End If
End Sub
Sub StartFreezePaneTimeRefresh()
Call SetFreezePane
RefreshTime = Now + TimeValue("00:00:01")
Application.OnTime RefreshTime, "StartFreezePaneTimeRefresh"
End Sub
Sub StopFreezePaneTimeRefresh()
On Error Resume Next
Application.OnTime RefreshTime, "StartFreezePaneTimeRefresh", , False
End Sub
Public Function IdentifyTopVisibleRow() As Long
'This code was found on MSDN at
'https://social.msdn.microsoft.com/Forums/en-US/a6cff632-e123-4190-8556-d9f48af8fe9a/identify-first-visible-row-of-scrolled-excel-worksheet?forum=isvvba
Dim lngTopRow As Long ' top row
Dim lngNumRows As Long ' number of visible rows
Dim lngLeftCol As Long ' leftmost column
Dim lngNumCols As Long ' number of visible columns
With ActiveWindow.VisibleRange
lngTopRow = .Row
lngNumRows = .Rows.Count
lngLeftCol = .Column
lngNumCols = .Columns.Count
End With
IdentifyTopVisibleRow = lngTopRow
End Function
The code works by first checking if the correct sheet is active and if it is then it checks the top most visible row every second.
If the top row is Greater or Lesser than the beginning rows of each table it then will check to see if the first header is already set to prevent it from changing the values over and over.
If not it changes the Frozen Row values based upon the users location in the workbook.
Notes:
The change is delayed by 1 second but that is acceptable for what I am doing this for.
The sheet I am using this on is view only as this would constantly shift the focus to the first row if you have an idea on how to set the first row values without changing selection that would make this work great.
I have an issue which i can't solve.I wrote this code:
Private Sub CommandButton2_Click()
Sheets("sheet2").OLEObjects("CheckBox1").Copy
Sheets("sheet3").Range("V7").PasteSpecial
End Sub
This code copy a checkbox from (sheet 2) to (sheet 3) starting from V7 cell. Now I want the next time I press the command button to paste the data to cell V12,next time to V17 etc. My vba knowledge is not very good as you can see.
This code will see how many checkboxes are already in the sheet you are pasting to and add 5 rows for each check box, then paste five rows under the last one.
Private Sub CommandButton2_Click()
' copy checkbox
Sheets("sheet2").OLEObjects("CheckBox1").Copy
Dim wks As Worksheet
Set wks = Sheets("Sheet3")
Dim cb As OLEObject, i As Integer
'determine how many boxes are already there and get count of cell to paste to
i = 7
For Each cb In wks.OLEObjects
If InStr(1, cb.Name, "CheckBox") Then i = i + 5
Next
'paste new checkbox
Sheets("sheet3").Range("V" & i).PasteSpecial
End Sub
Use a global variable. These must be at the top of your sheet, module, or form code above all subs and functions.
Then use that as the row number in your range. Range("V" & lRow)
Private lRow As Long
Private Sub CommandButton2_Click()
'Let's check if this is the first time the button has been used.
If lRow = 0 then
lRow = 7
Else
'Increment the row from the one we wrote to last time.
lRow = lRow + 5
End If
'Do the copy
Sheets("sheet2").OLEObjects("CheckBox1").Copy
Sheets("sheet3").Range("V" & lRow).PasteSpecial
End Sub
I dont know what data you got between in Sheet(3).Range("V7") and Sheet(3).Range("V12")
but juste before you're PasteSpecial, you shoud keep track where was the last time you paste data in Sheets("sheets3") in a specific cell in Sheet("sheets3"), in exemple : Sheets("Sheet3").Range("A1")
Then you'll be able to pastespecial to this cell 5 row under like this :
Sheets("sheet3").Range(Sheets("Sheets3").Range("A1").Offset(5,0)).PasteSpecial
right after that you update the Sheets("Sheets3").Range("A1") = Sheets("sheet3").Range(Sheets("Sheets3").Range("A1").Offset(5,0)).Address
So this should do the work :
Private Sub CommandButton2_Click()
Dim oWsSource as Worksheet
Dim oWsDestination as Worksheet
Set oWsDestination = ThisWorkbook.Worksheet("Sheets3")
Set oWsSource = ThisWorkbook.Worksheet("Sheets2")
'Do the copy
oWsSource.OLEObjects("CheckBox1").Copy
oWsDestination.Range(oWsDestination.Range("A1").Value).Offset(5,0)).PasteSpecial
oWsDestination.Range("A1").Value = oWsDestination.Range(oWsDestination.Range("A1").Value).Offset(5, 0)).Address
End Sub
All the answers put the first checkbox but the next one put it again to the same cell as before.I don't know if its matter but I use excel 2010.
I'm initializing a userform in an Excel VBA macro. When I go to populate the items in a combobox, I get stuck in an infinite loop, but I don't know why. Here is my code:
Private Sub UserForm_Initialize()
'Populate the combobox with the months
Me.cboCurrMth.SetFocus
Dim cMth As Range
Dim ws As Worksheet
Set ws = Sheet1
For Each cMth In ws.Range("months")
With Me.cboCurrMth
.AddItem cMth.Value
.List(.LineCount - 1, 1) = cMth.Offset(0, 1).Value
End With
Next cMth
End Sub
The named range "months" includes all 12 rows and 2 columns where the first column is an integer (from 1 to 12) and the second column is the string name of each month.
Anyone see why this loop won't terminate? Thanks.
You should rarely select cells or ranges in your production VBA code. However, it can be extremely helpful for debugging purposes.
Add a .select in your For Each loop and then step through your code. You should be able to figure out what's wrong.
Private Sub WhyAmIInfinite()
'Loop through and select the months
Dim cMth As Range
Dim ws As Worksheet
Set ws = Sheet1
For Each cMth In ws.Range("months")
cMth.Select
Next cMth
End Sub
I set up a worksheet with a range exactly as you describe and the loop exited as I expected it to. I removed the combobox from my example because I wanted to isolate the loop itself.
I have wrote the following code and it is worked for me. I am using Excel 2003.
ActiveSheet.Shapes("cmbMonths").Select
Dim currMonth As Range
With Selection
For Each currMonth In Range("Months")
.AddItem currMonth.Value
Next
End With
This line ".List(.LineCount - 1, 1) = cMth.Offset(0, 1).Value" is giving error for me 'Saying member not found"
Please select your month cells once again and give the name for the selected range and try again.
Hope it works.